home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / stdctrls.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  102.2 KB  |  3,670 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit StdCtrls;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Messages, Windows, SysUtils, Classes, Controls, Forms, Menus, Graphics;
  17.  
  18. type
  19.   TCustomGroupBox = class(TCustomControl)
  20.   private
  21.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  22.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  23.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  24.     procedure WMSize(var Message: TMessage); message WM_SIZE;
  25.   protected
  26.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  27.     procedure CreateParams(var Params: TCreateParams); override;
  28.     procedure Paint; override;
  29.   public
  30.     constructor Create(AOwner: TComponent); override;
  31.   end;
  32.  
  33.   TGroupBox = class(TCustomGroupBox)
  34.   published
  35.     property Align;
  36.     property Caption;
  37.     property Color;
  38.     property Ctl3D;
  39.     property DragCursor;
  40.     property DragMode;
  41.     property Enabled;
  42.     property Font;
  43.     property ParentColor;
  44.     property ParentCtl3D;
  45.     property ParentFont;
  46.     property ParentShowHint;
  47.     property PopupMenu;
  48.     property ShowHint;
  49.     property TabOrder;
  50.     property TabStop;
  51.     property Visible;
  52.     property OnClick;
  53.     property OnDblClick;
  54.     property OnDragDrop;
  55.     property OnDragOver;
  56.     property OnEndDrag;
  57.     property OnEnter;
  58.     property OnExit;
  59.     property OnMouseDown;
  60.     property OnMouseMove;
  61.     property OnMouseUp;
  62.     property OnStartDrag;
  63.   end;
  64.  
  65.   TTextLayout = (tlTop, tlCenter, tlBottom);
  66.   
  67.   TCustomLabel = class(TGraphicControl)
  68.   private
  69.     FFocusControl: TWinControl;
  70.     FAlignment: TAlignment;
  71.     FAutoSize: Boolean;
  72.     FLayout: TTextLayout;
  73.     FWordWrap: Boolean;
  74.     FShowAccelChar: Boolean;
  75.     procedure AdjustBounds;
  76.     procedure DoDrawText(var Rect: TRect; Flags: Word);
  77.     function GetTransparent: Boolean;
  78.     procedure SetAlignment(Value: TAlignment);
  79.     procedure SetFocusControl(Value: TWinControl);
  80.     procedure SetShowAccelChar(Value: Boolean);
  81.     procedure SetTransparent(Value: Boolean);
  82.     procedure SetLayout(Value: TTextLayout);
  83.     procedure SetWordWrap(Value: Boolean);
  84.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  85.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  86.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  87.   protected
  88.     function GetLabelText: string; virtual;
  89.     procedure Notification(AComponent: TComponent;
  90.       Operation: TOperation); override;
  91.     procedure Paint; override;
  92.     procedure SetAutoSize(Value: Boolean); virtual;
  93.     property Alignment: TAlignment read FAlignment write SetAlignment
  94.       default taLeftJustify;
  95.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  96.     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
  97.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
  98.     property Transparent: Boolean read GetTransparent write SetTransparent default False;
  99.     property Layout: TTextLayout read FLayout write SetLayout default tlTop;
  100.     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  101.   public
  102.     constructor Create(AOwner: TComponent); override;
  103.     property Canvas;
  104.   end;
  105.  
  106.   TLabel = class(TCustomLabel)
  107.   published
  108.     property Align;
  109.     property Alignment;
  110.     property AutoSize;
  111.     property Caption;
  112.     property Color;
  113.     property DragCursor;
  114.     property DragMode;
  115.     property Enabled;
  116.     property FocusControl;
  117.     property Font;
  118.     property ParentColor;
  119.     property ParentFont;
  120.     property ParentShowHint;
  121.     property PopupMenu;
  122.     property ShowAccelChar;
  123.     property ShowHint;
  124.     property Transparent;
  125.     property Layout;
  126.     property Visible;
  127.     property WordWrap;
  128.     property OnClick;
  129.     property OnDblClick;
  130.     property OnDragDrop;
  131.     property OnDragOver;
  132.     property OnEndDrag;
  133.     property OnMouseDown;
  134.     property OnMouseMove;
  135.     property OnMouseUp;
  136.     property OnStartDrag;
  137.   end;
  138.  
  139.   TEditCharCase = (ecNormal, ecUpperCase, ecLowerCase);
  140.  
  141.   TCustomEdit = class(TWinControl)
  142.   private
  143.     FMaxLength: Integer;
  144.     FBorderStyle: TBorderStyle;
  145.     FPasswordChar: Char;
  146.     FReadOnly: Boolean;
  147.     FAutoSize: Boolean;
  148.     FAutoSelect: Boolean;
  149.     FHideSelection: Boolean;
  150.     FOEMConvert: Boolean;
  151.     FCharCase: TEditCharCase;
  152.     FCreating: Boolean;
  153.     FModified: Boolean;
  154.     FOnChange: TNotifyEvent;
  155.     procedure AdjustHeight;
  156.     procedure DefaultHandler(var Message); override;
  157.     function GetModified: Boolean;
  158.     procedure SetAutoSize(Value: Boolean);
  159.     procedure SetBorderStyle(Value: TBorderStyle);
  160.     procedure SetCharCase(Value: TEditCharCase);
  161.     procedure SetHideSelection(Value: Boolean);
  162.     procedure SetMaxLength(Value: Integer);
  163.     procedure SetModified(Value: Boolean);
  164.     procedure SetOEMConvert(Value: Boolean);
  165.     procedure SetPasswordChar(Value: Char);
  166.     procedure SetReadOnly(Value: Boolean);
  167.     procedure SetSelText(const Value: string);
  168.     procedure UpdateHeight;
  169.     procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
  170.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  171.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  172.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  173.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  174.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  175.   protected
  176.     procedure Change; dynamic;
  177.     procedure CreateParams(var Params: TCreateParams); override;
  178.     procedure CreateWnd; override;
  179.     procedure DestroyWnd; override;
  180.     procedure DoSetMaxLength(Value: Integer); virtual;
  181.     function GetSelLength: Integer; virtual;
  182.     function GetSelStart: Integer; virtual;
  183.     function GetSelText: string; virtual;
  184.     procedure SetSelLength(Value: Integer); virtual;
  185.     procedure SetSelStart(Value: Integer); virtual;
  186.     property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
  187.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  188.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  189.     property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
  190.     property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  191.     property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
  192.     property OEMConvert: Boolean read FOEMConvert write SetOEMConvert default False;
  193.     property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
  194.     property ParentColor default False;
  195.     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  196.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  197.   public
  198.     constructor Create(AOwner: TComponent); override;
  199.     procedure Clear; virtual;
  200.     procedure ClearSelection;
  201.     procedure CopyToClipboard;
  202.     procedure CutToClipboard;
  203.     procedure PasteFromClipboard;
  204.     function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
  205.     procedure SelectAll;
  206.     procedure SetSelTextBuf(Buffer: PChar);
  207.     property Modified: Boolean read GetModified write SetModified;
  208.     property SelLength: Integer read GetSelLength write SetSelLength;
  209.     property SelStart: Integer read GetSelStart write SetSelStart;
  210.     property SelText: string read GetSelText write SetSelText;
  211.     property Text;
  212.   published
  213.     property TabStop default True;
  214.   end;
  215.  
  216.   TEdit = class(TCustomEdit)
  217.   published
  218.     property AutoSelect;
  219.     property AutoSize;
  220.     property BorderStyle;
  221.     property CharCase;
  222.     property Color;
  223.     property Ctl3D;
  224.     property DragCursor;
  225.     property DragMode;
  226.     property Enabled;
  227.     property Font;
  228.     property HideSelection;
  229.     property ImeMode;
  230.     property ImeName;
  231.     property MaxLength;
  232.     property OEMConvert;
  233.     property ParentColor;
  234.     property ParentCtl3D;
  235.     property ParentFont;
  236.     property ParentShowHint;
  237.     property PasswordChar;
  238.     property PopupMenu;
  239.     property ReadOnly;
  240.     property ShowHint;
  241.     property TabOrder;
  242.     property TabStop;
  243.     property Text;
  244.     property Visible;
  245.     property OnChange;
  246.     property OnClick;
  247.     property OnDblClick;
  248.     property OnDragDrop;
  249.     property OnDragOver;
  250.     property OnEndDrag;
  251.     property OnEnter;
  252.     property OnExit;
  253.     property OnKeyDown;
  254.     property OnKeyPress;
  255.     property OnKeyUp;
  256.     property OnMouseDown;
  257.     property OnMouseMove;
  258.     property OnMouseUp;
  259.     property OnStartDrag;
  260.   end;
  261.  
  262.   TScrollStyle = (ssNone, ssHorizontal, ssVertical, ssBoth);
  263.  
  264.   TCustomMemo = class(TCustomEdit)
  265.   private
  266.     FLines: TStrings;
  267.     FAlignment: TAlignment;
  268.     FScrollBars: TScrollStyle;
  269.     FWordWrap: Boolean;
  270.     FWantReturns: Boolean;
  271.     FWantTabs: Boolean;
  272.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  273.     procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  274.   protected
  275.     procedure CreateParams(var Params: TCreateParams); override;
  276.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  277.     procedure KeyPress(var Key: Char); override;
  278.     procedure Loaded; override;
  279.     procedure SetAlignment(Value: TAlignment);
  280.     procedure SetLines(Value: TStrings);
  281.     procedure SetScrollBars(Value: TScrollStyle);
  282.     procedure SetWordWrap(Value: Boolean);
  283.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  284.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssNone;
  285.     property WantReturns: Boolean read FWantReturns write FWantReturns default True;
  286.     property WantTabs: Boolean read FWantTabs write FWantTabs default False;
  287.     property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  288.   public
  289.     constructor Create(AOwner: TComponent); override;
  290.     destructor Destroy; override;
  291.     property Lines: TStrings read FLines write SetLines;
  292.   end;
  293.  
  294.   TMemo = class(TCustomMemo)
  295.   published
  296.     property Align;
  297.     property Alignment;
  298.     property BorderStyle;
  299.     property Color;
  300.     property Ctl3D;
  301.     property DragCursor;
  302.     property DragMode;
  303.     property Enabled;
  304.     property Font;
  305.     property HideSelection;
  306.     property ImeMode;
  307.     property ImeName;
  308.     property Lines;
  309.     property MaxLength;
  310.     property OEMConvert;
  311.     property ParentColor;
  312.     property ParentCtl3D;
  313.     property ParentFont;
  314.     property ParentShowHint;
  315.     property PopupMenu;
  316.     property ReadOnly;
  317.     property ScrollBars;
  318.     property ShowHint;
  319.     property TabOrder;
  320.     property TabStop;
  321.     property Visible;
  322.     property WantReturns;
  323.     property WantTabs;
  324.     property WordWrap;
  325.     property OnChange;
  326.     property OnClick;
  327.     property OnDblClick;
  328.     property OnDragDrop;
  329.     property OnDragOver;
  330.     property OnEndDrag;
  331.     property OnEnter;
  332.     property OnExit;
  333.     property OnKeyDown;
  334.     property OnKeyPress;
  335.     property OnKeyUp;
  336.     property OnMouseDown;
  337.     property OnMouseMove;
  338.     property OnMouseUp;
  339.     property OnStartDrag;
  340.   end;
  341.  
  342.   TComboBoxStyle = (csDropDown, csSimple, csDropDownList, csOwnerDrawFixed,
  343.     csOwnerDrawVariable);
  344.   TOwnerDrawState = set of (odSelected, odGrayed, odDisabled, odChecked,
  345.     odFocused);
  346.  
  347.   TDrawItemEvent = procedure(Control: TWinControl; Index: Integer;
  348.     Rect: TRect; State: TOwnerDrawState) of object;
  349.  
  350.   TMeasureItemEvent = procedure(Control: TWinControl; Index: Integer;
  351.     var Height: Integer) of object;
  352.  
  353.   TCustomComboBox = class(TWinControl)
  354.   private
  355.     FItems: TStrings;
  356.     FCanvas: TCanvas;
  357.     FSorted: Boolean;
  358.     FStyle: TComboBoxStyle;
  359.     FItemHeight: Integer;
  360.     FMaxLength: Integer;
  361.     FDropDownCount: Integer;
  362.     FEditHandle: HWnd;
  363.     FListHandle: HWnd;
  364.     FEditInstance: Pointer;
  365.     FListInstance: Pointer;
  366.     FDefEditProc: Pointer;
  367.     FDefListProc: Pointer;
  368.     FIsFocused: Boolean;
  369.     FFocusChanged: Boolean;
  370.     FSaveItems: TStringList;
  371.     FOnChange: TNotifyEvent;
  372.     FOnDropDown: TNotifyEvent;
  373.     FOnDrawItem: TDrawItemEvent;
  374.     FOnMeasureItem: TMeasureItemEvent;
  375.     procedure AdjustDropDown;
  376.     procedure EditWndProc(var Message: TMessage);
  377.     function GetDroppedDown: Boolean;
  378.     function GetItemIndex: Integer;
  379.     function GetSelLength: Integer;
  380.     function GetSelStart: Integer;
  381.     function GetSelText: string;
  382.     procedure ListWndProc(var Message: TMessage);
  383.     procedure SetDroppedDown(Value: Boolean);
  384.     procedure SetItems(Value: TStrings);
  385.     procedure SetItemIndex(Value: Integer);
  386.     procedure SetSelLength(Value: Integer);
  387.     procedure SetSelStart(Value: Integer);
  388.     procedure SetSelText(const Value: string);
  389.     procedure SetSorted(Value: Boolean);
  390.     function  GetItemHeight: Integer;
  391.     procedure SetItemHeight(Value: Integer);
  392.     procedure SetMaxLength(Value: Integer);
  393.     procedure WMCreate(var Message: TWMCreate); message WM_CREATE;
  394.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  395.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  396.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  397.     procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
  398.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  399.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  400.     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  401.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  402.     procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  403.     procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
  404.     procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM;
  405.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  406.   protected
  407.     procedure ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  408.       ComboProc: Pointer); virtual;
  409.     procedure WndProc(var Message: TMessage); override;
  410.     procedure CreateParams(var Params: TCreateParams); override;
  411.     procedure CreateWnd; override;
  412.     procedure DestroyWnd; override;
  413.     procedure DrawItem(Index: Integer; Rect: TRect;
  414.       State: TOwnerDrawState); virtual;
  415.     procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
  416.     procedure Change; dynamic;
  417.     procedure DropDown; dynamic;
  418.     procedure SetStyle(Value: TComboBoxStyle); virtual;
  419.     property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8;
  420.     property EditHandle: HWnd read FEditHandle;
  421.     property ItemHeight: Integer read GetItemHeight write SetItemHeight;
  422.     property ListHandle: HWnd read FListHandle;
  423.     property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
  424.     property ParentColor default False;
  425.     property Sorted: Boolean read FSorted write SetSorted default False;
  426.     property Style: TComboBoxStyle read FStyle write SetStyle default csDropDown;
  427.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  428.     property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
  429.     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
  430.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  431.   public
  432.     constructor Create(AOwner: TComponent); override;
  433.     destructor Destroy; override;
  434.     procedure Clear;
  435.     procedure SelectAll;
  436.     property Canvas: TCanvas read FCanvas;
  437.     property DroppedDown: Boolean read GetDroppedDown write SetDroppedDown;
  438.     property Items: TStrings read FItems write SetItems;
  439.     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  440.     property SelLength: Integer read GetSelLength write SetSelLength;
  441.     property SelStart: Integer read GetSelStart write SetSelStart;
  442.     property SelText: string read GetSelText write SetSelText;
  443.   published
  444.     property TabStop default True;
  445.   end;
  446.  
  447.   TComboBox = class(TCustomComboBox)
  448.   published
  449.     property Style; {Must be published before Items}
  450.     property Color;
  451.     property Ctl3D;
  452.     property DragMode;
  453.     property DragCursor;
  454.     property DropDownCount;
  455.     property Enabled;
  456.     property Font;
  457.     property ImeMode;
  458.     property ImeName;
  459.     property ItemHeight;
  460.     property Items;
  461.     property MaxLength;
  462.     property ParentColor;
  463.     property ParentCtl3D;
  464.     property ParentFont;
  465.     property ParentShowHint;
  466.     property PopupMenu;
  467.     property ShowHint;
  468.     property Sorted;
  469.     property TabOrder;
  470.     property TabStop;
  471.     property Text;
  472.     property Visible;
  473.     property OnChange;
  474.     property OnClick;
  475.     property OnDblClick;
  476.     property OnDragDrop;
  477.     property OnDragOver;
  478.     property OnDrawItem;
  479.     property OnDropDown;
  480.     property OnEndDrag;
  481.     property OnEnter;
  482.     property OnExit;
  483.     property OnKeyDown;
  484.     property OnKeyPress;
  485.     property OnKeyUp;
  486.     property OnMeasureItem;
  487.     property OnStartDrag;
  488.   end;
  489.  
  490.   TButtonControl = class(TWinControl)
  491.   private
  492.     FClicksDisabled: Boolean;
  493.   protected
  494.     procedure WndProc(var Message: TMessage); override;
  495.   end;
  496.  
  497.   TButton = class(TButtonControl)
  498.   private
  499.     FDefault: Boolean;
  500.     FCancel: Boolean;
  501.     FActive: Boolean;
  502.     FModalResult: TModalResult;
  503.     procedure SetDefault(Value: Boolean);
  504.     procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  505.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  506.     procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
  507.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  508.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  509.   protected
  510.     procedure CreateParams(var Params: TCreateParams); override;
  511.     procedure CreateWnd; override;
  512.     procedure SetButtonStyle(ADefault: Boolean); virtual;
  513.   public
  514.     constructor Create(AOwner: TComponent); override;
  515.     procedure Click; override;
  516.   published
  517.     property Cancel: Boolean read FCancel write FCancel default False;
  518.     property Caption;
  519.     property Default: Boolean read FDefault write SetDefault default False;
  520.     property DragCursor;
  521.     property DragMode;
  522.     property Enabled;
  523.     property Font;
  524.     property ModalResult: TModalResult read FModalResult write FModalResult default 0;
  525.     property ParentFont;
  526.     property ParentShowHint;
  527.     property PopupMenu;
  528.     property ShowHint;
  529.     property TabOrder;
  530.     property TabStop default True;
  531.     property Visible;
  532.     property OnClick;
  533.     property OnDragDrop;
  534.     property OnDragOver;
  535.     property OnEndDrag;
  536.     property OnEnter;
  537.     property OnExit;
  538.     property OnKeyDown;
  539.     property OnKeyPress;
  540.     property OnKeyUp;
  541.     property OnMouseDown;
  542.     property OnMouseMove;
  543.     property OnMouseUp;
  544.     property OnStartDrag;
  545.   end;
  546.  
  547.   TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);
  548.  
  549.   TCustomCheckBox = class(TButtonControl)
  550.   private
  551.     FAlignment: TLeftRight;
  552.     FAllowGrayed: Boolean;
  553.     FState: TCheckBoxState;
  554.     function GetChecked: Boolean;
  555.     procedure SetAlignment(Value: TLeftRight);
  556.     procedure SetChecked(Value: Boolean);
  557.     procedure SetState(Value: TCheckBoxState);
  558.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  559.     procedure WMSize(var Message: TMessage); message WM_SIZE;
  560.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  561.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  562.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  563.   protected
  564.     procedure Toggle; virtual;
  565.     procedure Click; override;
  566.     procedure CreateParams(var Params: TCreateParams); override;
  567.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  568.     procedure CreateWnd; override;
  569.     property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
  570.     property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
  571.     property Checked: Boolean read GetChecked write SetChecked stored False;
  572.     property State: TCheckBoxState read FState write SetState default cbUnchecked;
  573.   public
  574.     constructor Create(AOwner: TComponent); override;
  575.   published
  576.     property TabStop default True;
  577.   end;
  578.  
  579.   TCheckBox = class(TCustomCheckBox)
  580.   published
  581.     property Alignment;
  582.     property AllowGrayed;
  583.     property Caption;
  584.     property Checked;
  585.     property Color;
  586.     property Ctl3D;
  587.     property DragCursor;
  588.     property DragMode;
  589.     property Enabled;
  590.     property Font;
  591.     property ParentColor;
  592.     property ParentCtl3D;
  593.     property ParentFont;
  594.     property ParentShowHint;
  595.     property PopupMenu;
  596.     property ShowHint;
  597.     property State;
  598.     property TabOrder;
  599.     property TabStop;
  600.     property Visible;
  601.     property OnClick;
  602.     property OnDragDrop;
  603.     property OnDragOver;
  604.     property OnEndDrag;
  605.     property OnEnter;
  606.     property OnExit;
  607.     property OnKeyDown;
  608.     property OnKeyPress;
  609.     property OnKeyUp;
  610.     property OnMouseDown;
  611.     property OnMouseMove;
  612.     property OnMouseUp;
  613.     property OnStartDrag;
  614.   end;
  615.  
  616.   TRadioButton = class(TButtonControl)
  617.   private
  618.     FAlignment: TLeftRight;
  619.     FChecked: Boolean;
  620.     procedure SetAlignment(Value: TLeftRight);
  621.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  622.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  623.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  624.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  625.   protected
  626.     procedure SetChecked(Value: Boolean);
  627.     procedure CreateParams(var Params: TCreateParams); override;
  628.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  629.     procedure CreateWnd; override;
  630.   public
  631.     constructor Create(AOwner: TComponent); override;
  632.   published
  633.     property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
  634.     property Caption;
  635.     property Checked: Boolean read FChecked write SetChecked default False;
  636.     property Color;
  637.     property Ctl3D;
  638.     property DragCursor;
  639.     property DragMode;
  640.     property Enabled;
  641.     property Font;
  642.     property ParentColor;
  643.     property ParentCtl3D;
  644.     property ParentFont;
  645.     property ParentShowHint;
  646.     property PopupMenu;
  647.     property ShowHint;
  648.     property TabOrder;
  649.     property TabStop;
  650.     property Visible;
  651.     property OnClick;
  652.     property OnDblClick;
  653.     property OnDragDrop;
  654.     property OnDragOver;
  655.     property OnEndDrag;
  656.     property OnEnter;
  657.     property OnExit;
  658.     property OnKeyDown;
  659.     property OnKeyPress;
  660.     property OnKeyUp;
  661.     property OnMouseDown;
  662.     property OnMouseMove;
  663.     property OnMouseUp;
  664.     property OnStartDrag;
  665.   end;
  666.  
  667.   TListBoxStyle = (lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable);
  668.  
  669.   TCustomListBox = class(TWinControl)
  670.   private
  671.     FItems: TStrings;
  672.     FBorderStyle: TBorderStyle;
  673.     FCanvas: TCanvas;
  674.     FColumns: Integer;
  675.     FItemHeight: Integer;
  676.     FStyle: TListBoxStyle;
  677.     FIntegralHeight: Boolean;
  678.     FMultiSelect: Boolean;
  679.     FSorted: Boolean;
  680.     FExtendedSelect: Boolean;
  681.     FTabWidth: Integer;
  682.     FSaveItems: TStringList;
  683.     FSaveTopIndex: Integer;
  684.     FSaveItemIndex: Integer;
  685.     FOnDrawItem: TDrawItemEvent;
  686.     FOnMeasureItem: TMeasureItemEvent;
  687.     function GetItemHeight: Integer;
  688.     function GetItemIndex: Integer;
  689.     function GetSelCount: Integer;
  690.     function GetSelected(Index: Integer): Boolean;
  691.     function GetTopIndex: Integer;
  692.     procedure SetBorderStyle(Value: TBorderStyle);
  693.     procedure SetColumnWidth;
  694.     procedure SetColumns(Value: Integer);
  695.     procedure SetExtendedSelect(Value: Boolean);
  696.     procedure SetIntegralHeight(Value: Boolean);
  697.     procedure SetItemHeight(Value: Integer);
  698.     procedure SetItems(Value: TStrings);
  699.     procedure SetItemIndex(Value: Integer);
  700.     procedure SetMultiSelect(Value: Boolean);
  701.     procedure SetSelected(Index: Integer; Value: Boolean);
  702.     procedure SetSorted(Value: Boolean);
  703.     procedure SetStyle(Value: TListBoxStyle);
  704.     procedure SetTabWidth(Value: Integer);
  705.     procedure SetTopIndex(Value: Integer);
  706.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  707.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  708.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  709.     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  710.     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
  711.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  712.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  713.   protected
  714.     procedure CreateParams(var Params: TCreateParams); override;
  715.     procedure CreateWnd; override;
  716.     procedure DestroyWnd; override;
  717.     procedure WndProc(var Message: TMessage); override;
  718.     procedure DragCanceled; override;
  719.     procedure DrawItem(Index: Integer; Rect: TRect;
  720.       State: TOwnerDrawState); virtual;
  721.     procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
  722.     function GetItemData(Index: Integer): LongInt; dynamic;
  723.     procedure SetItemData(Index: Integer; AData: LongInt); dynamic;
  724.     procedure ResetContent; dynamic;
  725.     procedure DeleteString(Index: Integer); dynamic;
  726.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  727.     property Columns: Integer read FColumns write SetColumns default 0;
  728.     property ExtendedSelect: Boolean read FExtendedSelect write SetExtendedSelect default True;
  729.     property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default False;
  730.     property ItemHeight: Integer read GetItemHeight write SetItemHeight;
  731.     property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
  732.     property ParentColor default False;
  733.     property Sorted: Boolean read FSorted write SetSorted default False;
  734.     property Style: TListBoxStyle read FStyle write SetStyle default lbStandard;
  735.     property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
  736.     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
  737.     property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
  738.   public
  739.     constructor Create(AOwner: TComponent); override;
  740.     destructor Destroy; override;
  741.     procedure Clear;
  742.     function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
  743.     function ItemRect(Index: Integer): TRect;
  744.     property Canvas: TCanvas read FCanvas;
  745.     property Items: TStrings read FItems write SetItems;
  746.     property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  747.     property SelCount: Integer read GetSelCount;
  748.     property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
  749.     property TopIndex: Integer read GetTopIndex write SetTopIndex;
  750.   published
  751.     property TabStop default True;
  752.   end;
  753.  
  754.   TListBox = class(TCustomListBox)
  755.   published
  756.     property Align;
  757.     property BorderStyle;
  758.     property Color;
  759.     property Columns;
  760.     property Ctl3D;
  761.     property DragCursor;
  762.     property DragMode;
  763.     property Enabled;
  764.     property ExtendedSelect;
  765.     property Font;
  766.     property ImeMode;
  767.     property ImeName;
  768.     property IntegralHeight;
  769.     property ItemHeight;
  770.     property Items;
  771.     property MultiSelect;
  772.     property ParentColor;
  773.     property ParentCtl3D;
  774.     property ParentFont;
  775.     property ParentShowHint;
  776.     property PopupMenu;
  777.     property ShowHint;
  778.     property Sorted;
  779.     property Style;
  780.     property TabOrder;
  781.     property TabStop;
  782.     property TabWidth;
  783.     property Visible;
  784.     property OnClick;
  785.     property OnDblClick;
  786.     property OnDragDrop;
  787.     property OnDragOver;
  788.     property OnDrawItem;
  789.     property OnEndDrag;
  790.     property OnEnter;
  791.     property OnExit;
  792.     property OnKeyDown;
  793.     property OnKeyPress;
  794.     property OnKeyUp;
  795.     property OnMeasureItem;
  796.     property OnMouseDown;
  797.     property OnMouseMove;
  798.     property OnMouseUp;
  799.     property OnStartDrag;
  800.   end;
  801.  
  802.   TScrollCode = (scLineUp, scLineDown, scPageUp, scPageDown, scPosition,
  803.     scTrack, scTop, scBottom, scEndScroll);
  804.  
  805.   TScrollEvent = procedure(Sender: TObject; ScrollCode: TScrollCode;
  806.     var ScrollPos: Integer) of object;
  807.  
  808.   TScrollBar = class(TWinControl)
  809.   private
  810.     FKind: TScrollBarKind;
  811.     FPosition: Integer;
  812.     FMin: Integer;
  813.     FMax: Integer;
  814.     FSmallChange: TScrollBarInc;
  815.     FLargeChange: TScrollBarInc;
  816.     FOnChange: TNotifyEvent;
  817.     FOnScroll: TScrollEvent;
  818.     procedure DoScroll(var Message: TWMScroll);
  819.     procedure SetKind(Value: TScrollBarKind);
  820.     procedure SetMax(Value: Integer);
  821.     procedure SetMin(Value: Integer);
  822.     procedure SetPosition(Value: Integer);
  823.     procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
  824.     procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  825.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  826.   protected
  827.     procedure CreateParams(var Params: TCreateParams); override;
  828.     procedure CreateWnd; override;
  829.     procedure Change; dynamic;
  830.     procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
  831.   public
  832.     constructor Create(AOwner: TComponent); override;
  833.     procedure SetParams(APosition, AMin, AMax: Integer);
  834.   published
  835.     property Ctl3D;
  836.     property DragCursor;
  837.     property DragMode;
  838.     property Enabled;
  839.     property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
  840.     property LargeChange: TScrollBarInc read FLargeChange write FLargeChange default 1;
  841.     property Max: Integer read FMax write SetMax default 100;
  842.     property Min: Integer read FMin write SetMin default 0;
  843.     property ParentCtl3D;
  844.     property ParentShowHint;
  845.     property PopupMenu;
  846.     property Position: Integer read FPosition write SetPosition default 0;
  847.     property ShowHint;
  848.     property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1;
  849.     property TabOrder;
  850.     property TabStop default True;
  851.     property Visible;
  852.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  853.     property OnDragDrop;
  854.     property OnDragOver;
  855.     property OnEndDrag;
  856.     property OnEnter;
  857.     property OnExit;
  858.     property OnKeyDown;
  859.     property OnKeyPress;
  860.     property OnKeyUp;
  861.     property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
  862.     property OnStartDrag;
  863.   end;
  864.  
  865.   TStaticBorderStyle = (sbsNone, sbsSingle, sbsSunken);
  866.  
  867.   TCustomStaticText = class(TWinControl)
  868.   private
  869.     FAlignment: TAlignment;
  870.     FAutoSize: Boolean;
  871.     FBorderStyle: TStaticBorderStyle;
  872.     FFocusControl: TWinControl;
  873.     FShowAccelChar: Boolean;
  874.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  875.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  876.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  877.     procedure AdjustBounds;
  878.     procedure SetAlignment(Value: TAlignment);
  879.     procedure SetAutoSize(Value: Boolean);
  880.     procedure SetBorderStyle(Value: TStaticBorderStyle);
  881.     procedure SetFocusControl(Value: TWinControl);
  882.     procedure SetShowAccelChar(Value: Boolean);
  883.   protected
  884.     procedure CreateParams(var Params: TCreateParams); override;
  885.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  886.     property Alignment: TAlignment read FAlignment write SetAlignment
  887.       default taLeftJustify;
  888.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  889.     property BorderStyle: TStaticBorderStyle read FBorderStyle
  890.       write SetBorderStyle default sbsNone;
  891.     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
  892.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar
  893.       default True;
  894.   public
  895.     constructor Create(AOwner: TComponent); override;
  896.   end;
  897.  
  898.   TStaticText = class(TCustomStaticText)
  899.   published
  900.     property Alignment;
  901.     property AutoSize;
  902.     property BorderStyle;
  903.     property Caption;
  904.     property Color;
  905.     property DragCursor;
  906.     property DragMode;
  907.     property Enabled;
  908.     property FocusControl;
  909.     property Font;
  910.     property ParentColor;
  911.     property ParentFont;
  912.     property ParentShowHint;
  913.     property PopupMenu;
  914.     property ShowAccelChar;
  915.     property ShowHint;
  916.     property TabOrder;
  917.     property TabStop;
  918.     property Visible;
  919.     property OnClick;
  920.     property OnDblClick;
  921.     property OnDragDrop;
  922.     property OnDragOver;
  923.     property OnEndDrag;
  924.     property OnMouseDown;
  925.     property OnMouseMove;
  926.     property OnMouseUp;
  927.     property OnStartDrag;
  928.   end;
  929.  
  930. implementation
  931.  
  932. uses Consts;
  933.  
  934. function HasPopup(Control: TControl): Boolean;
  935. begin
  936.   Result := True;
  937.   while Control <> nil do
  938.     if TCustomEdit(Control).PopupMenu <> nil then Exit else Control := Control.Parent;
  939.   Result := False;
  940. end;
  941.  
  942. type
  943.   TSelection = record
  944.     StartPos, EndPos: Integer;
  945.   end;
  946.  
  947.   TMemoStrings = class(TStrings)
  948.   private
  949.     Memo: TCustomMemo;
  950.   protected
  951.     function Get(Index: Integer): string; override;
  952.     function GetCount: Integer; override;
  953.     function GetTextStr: string; override;
  954.     procedure Put(Index: Integer; const S: string); override;
  955.     procedure SetTextStr(const Value: string); override;
  956.     procedure SetUpdateState(Updating: Boolean); override;
  957.   public
  958.     procedure Clear; override;
  959.     procedure Delete(Index: Integer); override;
  960.     procedure Insert(Index: Integer; const S: string); override;
  961.   end;
  962.  
  963.   TComboBoxStrings = class(TStrings)
  964.   private
  965.     ComboBox: TCustomComboBox;
  966.   protected
  967.     function Get(Index: Integer): string; override;
  968.     function GetCount: Integer; override;
  969.     function GetObject(Index: Integer): TObject; override;
  970.     procedure PutObject(Index: Integer; AObject: TObject); override;
  971.     procedure SetUpdateState(Updating: Boolean); override;
  972.   public
  973.     function Add(const S: string): Integer; override;
  974.     procedure Clear; override;
  975.     procedure Delete(Index: Integer); override;
  976.     procedure Insert(Index: Integer; const S: string); override;
  977.   end;
  978.  
  979.   TListBoxStrings = class(TStrings)
  980.   private
  981.     ListBox: TCustomListBox;
  982.   protected
  983.     function Get(Index: Integer): string; override;
  984.     function GetCount: Integer; override;
  985.     function GetObject(Index: Integer): TObject; override;
  986.     procedure PutObject(Index: Integer; AObject: TObject); override;
  987.     procedure SetUpdateState(Updating: Boolean); override;
  988.   public
  989.     function Add(const S: string): Integer; override;
  990.     procedure Clear; override;
  991.     procedure Delete(Index: Integer); override;
  992.     procedure Insert(Index: Integer; const S: string); override;
  993.   end;
  994.  
  995. const
  996.   BorderStyles: array[TBorderStyle] of Longint = (0, WS_BORDER);
  997.  
  998. { TCustomGroupBox }
  999.  
  1000. constructor TCustomGroupBox.Create(AOwner: TComponent);
  1001. begin
  1002.   inherited Create(AOwner);
  1003.   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  1004.     csSetCaption, csDoubleClicks, csReplicatable];
  1005.   Width := 185;
  1006.   Height := 105;
  1007. end;
  1008.  
  1009. procedure TCustomGroupBox.AlignControls(AControl: TControl; var Rect: TRect);
  1010. begin
  1011.   Canvas.Font := Font;
  1012.   Inc(Rect.Top, Canvas.TextHeight('0'));
  1013.   InflateRect(Rect, -1, -1);
  1014.   if Ctl3d then InflateRect(Rect, -1, -1);
  1015.   inherited AlignControls(AControl, Rect);
  1016. end;
  1017.  
  1018. procedure TCustomGroupBox.CreateParams(var Params: TCreateParams);
  1019. begin
  1020.   inherited CreateParams(Params);
  1021.   with Params.WindowClass do
  1022.     style := style and not (CS_HREDRAW or CS_VREDRAW);
  1023. end;
  1024.  
  1025. procedure TCustomGroupBox.Paint;
  1026. var
  1027.   H: Integer;
  1028.   R: TRect;
  1029. begin
  1030.   with Canvas do
  1031.   begin
  1032.     Font := Self.Font;
  1033.     H := TextHeight('0');
  1034.     R := Rect(0, H div 2 - 1, Width, Height);
  1035.     if Ctl3D then
  1036.     begin
  1037.       Inc(R.Left);
  1038.       Inc(R.Top);
  1039.       Brush.Color := clBtnHighlight;
  1040.       FrameRect(R);
  1041.       OffsetRect(R, -1, -1);
  1042.       Brush.Color := clBtnShadow;
  1043.     end else
  1044.       Brush.Color := clWindowFrame;
  1045.     FrameRect(R);
  1046.     if Text <> '' then
  1047.     begin
  1048.       R := Rect(8, 0, 0, H);
  1049.       DrawText(Handle, PChar(Text), Length(Text), R, DT_LEFT or DT_SINGLELINE or
  1050.         DT_CALCRECT);
  1051.       Brush.Color := Color;
  1052.       DrawText(Handle, PChar(Text), Length(Text), R, DT_LEFT or DT_SINGLELINE);
  1053.     end;
  1054.   end;
  1055. end;
  1056.  
  1057. procedure TCustomGroupBox.CMDialogChar(var Message: TCMDialogChar);
  1058. begin
  1059.   with Message do
  1060.     if IsAccel(CharCode, Caption) and CanFocus then
  1061.     begin
  1062.       SelectFirst;
  1063.       Result := 1;
  1064.     end else
  1065.       inherited;
  1066. end;
  1067.  
  1068. procedure TCustomGroupBox.CMTextChanged(var Message: TMessage);
  1069. begin
  1070.   Invalidate;
  1071.   Realign;
  1072. end;
  1073.  
  1074. procedure TCustomGroupBox.CMCtl3DChanged(var Message: TMessage);
  1075. begin
  1076.   inherited;
  1077.   Invalidate;
  1078.   Realign;
  1079. end;
  1080.  
  1081. procedure TCustomGroupBox.WMSize(var Message: TMessage);
  1082. begin
  1083.   inherited;
  1084.   Invalidate;
  1085. end;
  1086.  
  1087. { TCustomLabel }
  1088.  
  1089. constructor TCustomLabel.Create(AOwner: TComponent);
  1090. begin
  1091.   inherited Create(AOwner);
  1092.   ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  1093.   Width := 65;
  1094.   Height := 17;
  1095.   FAutoSize := True;
  1096.   FShowAccelChar := True;
  1097. end;
  1098.  
  1099. function TCustomLabel.GetLabelText: string;
  1100. begin
  1101.   Result := Caption;
  1102. end;
  1103.  
  1104. procedure TCustomLabel.DoDrawText(var Rect: TRect; Flags: Word);
  1105. var
  1106.   Text: string;
  1107. begin
  1108.   Text := GetLabelText;
  1109.   if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and
  1110.     (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  1111.   if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
  1112.   Canvas.Font := Font;
  1113.   if not Enabled then Canvas.Font.Color := clGrayText;
  1114.   DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  1115. end;
  1116.  
  1117. procedure TCustomLabel.Paint;
  1118. const
  1119.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  1120.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  1121. var
  1122.   Rect: TRect;
  1123.   DrawStyle: Integer;
  1124. begin
  1125.   with Canvas do
  1126.   begin
  1127.     if not Transparent then
  1128.     begin
  1129.       Brush.Color := Self.Color;
  1130.       Brush.Style := bsSolid;
  1131.       FillRect(ClientRect);
  1132.     end;
  1133.     Brush.Style := bsClear;
  1134.     Rect := ClientRect;
  1135.     DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
  1136.     { Calculate vertical layout }
  1137.     if FLayout <> tlTop then
  1138.     begin
  1139.       DoDrawText(Rect, DrawStyle or DT_CALCRECT);
  1140.       if FLayout = tlBottom then OffsetRect(Rect, 0, Height - Rect.Bottom)
  1141.       else OffsetRect(Rect, 0, (Height - Rect.Bottom) div 2);
  1142.     end;
  1143.     DoDrawText(Rect, DrawStyle);
  1144.   end;
  1145. end;
  1146.  
  1147. procedure TCustomLabel.AdjustBounds;
  1148. const
  1149.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  1150. var
  1151.   DC: HDC;
  1152.   X: Integer;
  1153.   Rect: TRect;
  1154. begin
  1155.   if not (csReading in ComponentState) and FAutoSize then
  1156.   begin
  1157.     Rect := ClientRect;
  1158.     DC := GetDC(0);
  1159.     Canvas.Handle := DC;
  1160.     DoDrawText(Rect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
  1161.     Canvas.Handle := 0;
  1162.     ReleaseDC(0, DC);
  1163.     X := Left;
  1164.     if FAlignment = taRightJustify then Inc(X, Width - Rect.Right);
  1165.     SetBounds(X, Top, Rect.Right, Rect.Bottom);
  1166.   end;
  1167. end;
  1168.  
  1169. procedure TCustomLabel.SetAlignment(Value: TAlignment);
  1170. begin
  1171.   if FAlignment <> Value then
  1172.   begin
  1173.     FAlignment := Value;
  1174.     Invalidate;
  1175.   end;
  1176. end;
  1177.  
  1178. procedure TCustomLabel.SetAutoSize(Value: Boolean);
  1179. begin
  1180.   if FAutoSize <> Value then
  1181.   begin
  1182.     FAutoSize := Value;
  1183.     AdjustBounds;
  1184.   end;
  1185. end;
  1186.  
  1187. function TCustomLabel.GetTransparent: Boolean;
  1188. begin
  1189.   Result := not (csOpaque in ControlStyle);
  1190. end;
  1191.  
  1192. procedure TCustomLabel.SetFocusControl(Value: TWinControl);
  1193. begin
  1194.   FFocusControl := Value;
  1195.   if Value <> nil then Value.FreeNotification(Self);
  1196. end;
  1197.  
  1198. procedure TCustomLabel.SetShowAccelChar(Value: Boolean);
  1199. begin
  1200.   if FShowAccelChar <> Value then
  1201.   begin
  1202.     FShowAccelChar := Value;
  1203.     Invalidate;
  1204.   end;
  1205. end;
  1206.  
  1207. procedure TCustomLabel.SetTransparent(Value: Boolean);
  1208. begin
  1209.   if Transparent <> Value then
  1210.   begin
  1211.     if Value then
  1212.       ControlStyle := ControlStyle - [csOpaque] else
  1213.       ControlStyle := ControlStyle + [csOpaque];
  1214.     Invalidate;
  1215.   end;
  1216. end;
  1217.  
  1218. procedure TCustomLabel.SetLayout(Value: TTextLayout);
  1219. begin
  1220.   if FLayout <> Value then
  1221.   begin
  1222.     FLayout := Value;
  1223.     Invalidate;
  1224.   end;
  1225. end;
  1226.  
  1227. procedure TCustomLabel.SetWordWrap(Value: Boolean);
  1228. begin
  1229.   if FWordWrap <> Value then
  1230.   begin
  1231.     FWordWrap := Value;
  1232.     AdjustBounds;
  1233.   end;
  1234. end;
  1235.  
  1236. procedure TCustomLabel.Notification(AComponent: TComponent;
  1237.   Operation: TOperation);
  1238. begin
  1239.   inherited Notification(AComponent, Operation);
  1240.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  1241.     FFocusControl := nil;
  1242. end;
  1243.  
  1244. procedure TCustomLabel.CMTextChanged(var Message: TMessage);
  1245. begin
  1246.   Invalidate;
  1247.   AdjustBounds;
  1248. end;
  1249.  
  1250. procedure TCustomLabel.CMFontChanged(var Message: TMessage);
  1251. begin
  1252.   inherited;
  1253.   AdjustBounds;
  1254. end;
  1255.  
  1256. procedure TCustomLabel.CMDialogChar(var Message: TCMDialogChar);
  1257. begin
  1258.   if (FFocusControl <> nil) and Enabled and ShowAccelChar and
  1259.     IsAccel(Message.CharCode, Caption) then
  1260.     with FFocusControl do
  1261.       if CanFocus then
  1262.       begin
  1263.         SetFocus;
  1264.         Message.Result := 1;
  1265.       end;
  1266. end;
  1267.  
  1268. { TCustomEdit }
  1269.  
  1270. constructor TCustomEdit.Create(AOwner: TComponent);
  1271. const
  1272.   EditStyle = [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight];
  1273. begin
  1274.   inherited Create(AOwner);
  1275.   if NewStyleControls then
  1276.     ControlStyle := EditStyle else
  1277.     ControlStyle := EditStyle + [csFramed];
  1278.   Width := 121;
  1279.   Height := 25;
  1280.   TabStop := True;
  1281.   ParentColor := False;
  1282.   FBorderStyle := bsSingle;
  1283.   FAutoSize := True;
  1284.   FAutoSelect := True;
  1285.   FHideSelection := True;
  1286.   AdjustHeight;
  1287. end;
  1288.  
  1289. procedure TCustomEdit.DoSetMaxLength(Value: Integer);
  1290. begin
  1291.   SendMessage(Handle, EM_LIMITTEXT, Value, 0)
  1292. end;
  1293.  
  1294. procedure TCustomEdit.SetAutoSize(Value: Boolean);
  1295. begin
  1296.   if FAutoSize <> Value then
  1297.   begin
  1298.     FAutoSize := Value;
  1299.     UpdateHeight;
  1300.   end;
  1301. end;
  1302.  
  1303. procedure TCustomEdit.SetBorderStyle(Value: TBorderStyle);
  1304. begin
  1305.   if FBorderStyle <> Value then
  1306.   begin
  1307.     FBorderStyle := Value;
  1308.     UpdateHeight;
  1309.     RecreateWnd;
  1310.   end;
  1311. end;
  1312.  
  1313. procedure TCustomEdit.SetCharCase(Value: TEditCharCase);
  1314. begin
  1315.   if FCharCase <> Value then
  1316.   begin
  1317.     FCharCase := Value;
  1318.     RecreateWnd;
  1319.   end;
  1320. end;
  1321.  
  1322. procedure TCustomEdit.SetHideSelection(Value: Boolean);
  1323. begin
  1324.   if FHideSelection <> Value then
  1325.   begin
  1326.     FHideSelection := Value;
  1327.     RecreateWnd;
  1328.   end;
  1329. end;
  1330.  
  1331. procedure TCustomEdit.SetMaxLength(Value: Integer);
  1332. begin
  1333.   if FMaxLength <> Value then
  1334.   begin
  1335.     FMaxLength := Value;
  1336.     if HandleAllocated then DoSetMaxLength(Value);
  1337.   end;
  1338. end;
  1339.  
  1340. procedure TCustomEdit.SetOEMConvert(Value: Boolean);
  1341. begin
  1342.   if FOEMConvert <> Value then
  1343.   begin
  1344.     FOEMConvert := Value;
  1345.     RecreateWnd;
  1346.   end;
  1347. end;
  1348.  
  1349. function TCustomEdit.GetModified: Boolean;
  1350. begin
  1351.   Result := FModified;
  1352.   if HandleAllocated then Result := SendMessage(Handle, EM_GETMODIFY, 0, 0) <> 0;
  1353. end;
  1354.  
  1355. procedure TCustomEdit.SetModified(Value: Boolean);
  1356. begin
  1357.   if HandleAllocated then
  1358.     SendMessage(Handle, EM_SETMODIFY, Byte(Value), 0) else
  1359.     FModified := Value;
  1360. end;
  1361.  
  1362. procedure TCustomEdit.SetPasswordChar(Value: Char);
  1363. begin
  1364.   if FPasswordChar <> Value then
  1365.   begin
  1366.     FPasswordChar := Value;
  1367.     if HandleAllocated then
  1368.     begin
  1369.       SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
  1370.       SetTextBuf(PChar(Text));
  1371.     end;
  1372.   end;
  1373. end;
  1374.  
  1375. procedure TCustomEdit.SetReadOnly(Value: Boolean);
  1376. begin
  1377.   if FReadOnly <> Value then
  1378.   begin
  1379.     FReadOnly := Value;
  1380.     if HandleAllocated then
  1381.       SendMessage(Handle, EM_SETREADONLY, Ord(Value), 0);
  1382.   end;
  1383. end;
  1384.  
  1385. function TCustomEdit.GetSelStart: Integer;
  1386. begin
  1387.   SendMessage(Handle, EM_GETSEL, Longint(@Result), 0);
  1388. end;
  1389.  
  1390. procedure TCustomEdit.SetSelStart(Value: Integer);
  1391. begin
  1392.   SendMessage(Handle, EM_SETSEL, Value, Value);
  1393. end;
  1394.  
  1395. function TCustomEdit.GetSelLength: Integer;
  1396. var
  1397.   Selection: TSelection;
  1398. begin
  1399.   SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  1400.   Result := Selection.EndPos - Selection.StartPos;
  1401. end;
  1402.  
  1403. procedure TCustomEdit.SetSelLength(Value: Integer);
  1404. var
  1405.   Selection: TSelection;
  1406. begin
  1407.   SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  1408.   Selection.EndPos := Selection.StartPos + Value;
  1409.   SendMessage(Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  1410.   SendMessage(Handle, EM_SCROLLCARET, 0,0);
  1411. end;
  1412.  
  1413. procedure TCustomEdit.Clear;
  1414. begin
  1415.   SetWindowText(Handle, '');
  1416. end;
  1417.  
  1418. procedure TCustomEdit.ClearSelection;
  1419. begin
  1420.   SendMessage(Handle, WM_CLEAR, 0, 0);
  1421. end;
  1422.  
  1423. procedure TCustomEdit.CopyToClipboard;
  1424. begin
  1425.   SendMessage(Handle, WM_COPY, 0, 0);
  1426. end;
  1427.  
  1428. procedure TCustomEdit.CutToClipboard;
  1429. begin
  1430.   SendMessage(Handle, WM_CUT, 0, 0);
  1431. end;
  1432.  
  1433. procedure TCustomEdit.PasteFromClipboard;
  1434. begin
  1435.   SendMessage(Handle, WM_PASTE, 0, 0);
  1436. end;
  1437.  
  1438. procedure TCustomEdit.SelectAll;
  1439. begin
  1440.   SendMessage(Handle, EM_SETSEL, 0, -1);
  1441. end;
  1442.  
  1443. function TCustomEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  1444. var
  1445.   P: PChar;
  1446.   StartPos: Integer;
  1447. begin
  1448.   StartPos := GetSelStart;
  1449.   Result := GetSelLength;
  1450.   P := StrAlloc(GetTextLen + 1);
  1451.   try
  1452.     GetTextBuf(P, StrBufSize(P));
  1453.     if Result >= BufSize then Result := BufSize - 1;
  1454.     StrLCopy(Buffer, P + StartPos, Result);
  1455.   finally
  1456.     StrDispose(P);
  1457.   end;
  1458. end;
  1459.  
  1460. procedure TCustomEdit.SetSelTextBuf(Buffer: PChar);
  1461. begin
  1462.   SendMessage(Handle, EM_REPLACESEL, 0, LongInt(Buffer));
  1463. end;
  1464.  
  1465. function TCustomEdit.GetSelText: string;
  1466. var
  1467.   P: PChar;
  1468.   SelStart, Len: Integer;
  1469. begin
  1470.   SelStart := GetSelStart;
  1471.   Len := GetSelLength;
  1472.   SetString(Result, PChar(nil), Len);
  1473.   if Len <> 0 then
  1474.   begin
  1475.     P := StrAlloc(GetTextLen + 1);
  1476.     try
  1477.       GetTextBuf(P, StrBufSize(P));
  1478.       Move(P[SelStart], Pointer(Result)^, Len);
  1479.     finally
  1480.       StrDispose(P);
  1481.     end;
  1482.   end;
  1483. end;
  1484.  
  1485. procedure TCustomEdit.SetSelText(const Value: String);
  1486. begin
  1487.   SendMessage(Handle, EM_REPLACESEL, 0, Longint(PChar(Value)));
  1488. end;
  1489.  
  1490. procedure TCustomEdit.CreateParams(var Params: TCreateParams);
  1491. const
  1492.   Passwords: array[Boolean] of Longint = (0, ES_PASSWORD);
  1493.   ReadOnlys: array[Boolean] of Longint = (0, ES_READONLY);
  1494.   CharCases: array[TEditCharCase] of Longint = (0, ES_UPPERCASE, ES_LOWERCASE);
  1495.   HideSelections: array[Boolean] of Longint = (ES_NOHIDESEL, 0);
  1496.   OEMConverts: array[Boolean] of Longint = (0, ES_OEMCONVERT);
  1497. begin
  1498.   inherited CreateParams(Params);
  1499.   CreateSubClass(Params, 'EDIT');
  1500.   with Params do
  1501.   begin
  1502.     Style := Style or (ES_AUTOHSCROLL or ES_AUTOVSCROLL) or
  1503.       BorderStyles[FBorderStyle] or Passwords[FPasswordChar <> #0] or
  1504.       ReadOnlys[FReadOnly] or CharCases[FCharCase] or
  1505.       HideSelections[FHideSelection] or OEMConverts[FOEMConvert];
  1506.     if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  1507.     begin
  1508.       Style := Style and not WS_BORDER;
  1509.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  1510.     end;
  1511.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  1512.   end;
  1513. end;
  1514.  
  1515. procedure TCustomEdit.CreateWnd;
  1516. begin
  1517.   FCreating := True;
  1518.   try
  1519.     inherited CreateWnd;
  1520.   finally
  1521.     FCreating := False;
  1522.   end;
  1523.   SendMessage(Handle, EM_LIMITTEXT, FMaxLength, 0);
  1524.   Modified := FModified;
  1525.   if FPasswordChar <> #0 then
  1526.     SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
  1527.   UpdateHeight;
  1528. end;
  1529.  
  1530. procedure TCustomEdit.DestroyWnd;
  1531. begin
  1532.   FModified := Modified;
  1533.   inherited DestroyWnd;
  1534. end;
  1535.  
  1536. procedure TCustomEdit.UpdateHeight;
  1537. begin
  1538.   if FAutoSize and (BorderStyle = bsSingle) then
  1539.   begin
  1540.     ControlStyle := ControlStyle + [csFixedHeight];
  1541.     AdjustHeight;
  1542.   end else
  1543.     ControlStyle := ControlStyle - [csFixedHeight];
  1544. end;
  1545.  
  1546. procedure TCustomEdit.AdjustHeight;
  1547. var
  1548.   DC: HDC;
  1549.   SaveFont: HFont;
  1550.   I: Integer;
  1551.   SysMetrics, Metrics: TTextMetric;
  1552. begin
  1553.   DC := GetDC(0);
  1554.   GetTextMetrics(DC, SysMetrics);
  1555.   SaveFont := SelectObject(DC, Font.Handle);
  1556.   GetTextMetrics(DC, Metrics);
  1557.   SelectObject(DC, SaveFont);
  1558.   ReleaseDC(0, DC);
  1559.   if NewStyleControls then
  1560.   begin
  1561.     if Ctl3D then I := 8 else I := 6;
  1562.     I := GetSystemMetrics(SM_CYBORDER) * I;
  1563.   end else
  1564.   begin
  1565.     I := SysMetrics.tmHeight;
  1566.     if I > Metrics.tmHeight then I := Metrics.tmHeight;
  1567.     I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  1568.   end;
  1569.   Height := Metrics.tmHeight + I;
  1570. end;
  1571.  
  1572. procedure TCustomEdit.Change;
  1573. begin
  1574.   inherited Changed;
  1575.   if Assigned(FOnChange) then FOnChange(Self);
  1576. end;
  1577.  
  1578. procedure TCustomEdit.DefaultHandler(var Message);
  1579. begin
  1580.   case TMessage(Message).Msg of
  1581.     WM_RBUTTONUP:
  1582.       if HasPopup(Self) then Exit;
  1583.     WM_SETFOCUS:
  1584.       if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
  1585.         not IsWindow(TWMSetFocus(Message).FocusedWnd) then
  1586.         TWMSetFocus(Message).FocusedWnd := 0;
  1587.   end;
  1588.   inherited;
  1589. end;
  1590.  
  1591. procedure TCustomEdit.WMSetFont(var Message: TWMSetFont);
  1592. begin
  1593.   inherited;
  1594.   if NewStyleControls and
  1595.     (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then
  1596.     SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  1597. end;
  1598.  
  1599. procedure TCustomEdit.CMCtl3DChanged(var Message: TMessage);
  1600. begin
  1601.   if NewStyleControls and (FBorderStyle = bsSingle) then
  1602.   begin
  1603.     UpdateHeight;
  1604.     RecreateWnd;
  1605.   end;
  1606.   inherited;
  1607. end;
  1608.  
  1609. procedure TCustomEdit.CMFontChanged(var Message: TMessage);
  1610. begin
  1611.   inherited;
  1612.   if (csFixedHeight in ControlStyle) and not ((csDesigning in
  1613.     ComponentState) and (csLoading in ComponentState)) then AdjustHeight;
  1614. end;
  1615.  
  1616. procedure TCustomEdit.CNCommand(var Message: TWMCommand);
  1617. begin
  1618.   if (Message.NotifyCode = EN_CHANGE) and not FCreating then Change;
  1619. end;
  1620.  
  1621. procedure TCustomEdit.CMEnter(var Message: TCMGotFocus);
  1622. begin
  1623.   if FAutoSelect and not (csLButtonDown in ControlState) and
  1624.     (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then SelectAll;
  1625.   inherited;
  1626. end;
  1627.  
  1628. procedure TCustomEdit.CMTextChanged(var Message: TMessage);
  1629. begin
  1630.   inherited;
  1631.   if not HandleAllocated or (GetWindowLong(Handle, GWL_STYLE) and
  1632.     ES_MULTILINE <> 0) then Change;
  1633. end;
  1634.  
  1635. { TMemoStrings }
  1636.  
  1637. function TMemoStrings.GetCount: Integer;
  1638. begin
  1639.   Result := 0;
  1640.   if Memo.HandleAllocated then
  1641.   begin
  1642.     Result := SendMessage(Memo.Handle, EM_GETLINECOUNT, 0, 0);
  1643.     if SendMessage(Memo.Handle, EM_LINELENGTH, SendMessage(Memo.Handle,
  1644.       EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
  1645.   end;
  1646. end;
  1647.  
  1648. function TMemoStrings.Get(Index: Integer): string;
  1649. var
  1650.   Text: array[0..4095] of Char;
  1651. begin
  1652.   Word((@Text)^) := SizeOf(Text);
  1653.   SetString(Result, Text, SendMessage(Memo.Handle, EM_GETLINE, Index,
  1654.     Longint(@Text)));
  1655. end;
  1656.  
  1657. procedure TMemoStrings.Put(Index: Integer; const S: string);
  1658. var
  1659.   SelStart: Integer;
  1660. begin
  1661.   SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1662.   if SelStart >= 0 then
  1663.   begin
  1664.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart +
  1665.       SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0));
  1666.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
  1667.   end;
  1668. end;
  1669.  
  1670. procedure TMemoStrings.Insert(Index: Integer; const S: string);
  1671. var
  1672.   SelStart, LineLen: Integer;
  1673.   Line: string;
  1674. begin
  1675.   if Index >= 0 then
  1676.   begin
  1677.     SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1678.     if SelStart >= 0 then Line := S + #13#10 else
  1679.     begin
  1680.       SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index - 1, 0);
  1681.       if SelStart < 0 then Exit;
  1682.       LineLen := SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
  1683.       if LineLen = 0 then Exit;
  1684.       Inc(SelStart, LineLen);
  1685.       Line := #13#10 + s;
  1686.     end;
  1687.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart);
  1688.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(PChar(Line)));
  1689.   end;
  1690. end;
  1691.  
  1692. procedure TMemoStrings.Delete(Index: Integer);
  1693. const
  1694.   Empty: PChar = '';
  1695. var
  1696.   SelStart, SelEnd: Integer;
  1697. begin
  1698.   SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  1699.   if SelStart >= 0 then
  1700.   begin
  1701.     SelEnd := SendMessage(Memo.Handle, EM_LINEINDEX, Index + 1, 0);
  1702.     if SelEnd < 0 then SelEnd := SelStart +
  1703.       SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
  1704.     SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelEnd);
  1705.     SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(Empty));
  1706.   end;
  1707. end;
  1708.  
  1709. procedure TMemoStrings.Clear;
  1710. begin
  1711.   Memo.Clear;
  1712. end;
  1713.  
  1714. procedure TMemoStrings.SetUpdateState(Updating: Boolean);
  1715. begin
  1716.   if Memo.HandleAllocated then
  1717.   begin
  1718.     SendMessage(Memo.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  1719.     if not Updating then
  1720.     begin   // WM_SETREDRAW causes visibility side effects in memo controls
  1721.       Memo.Perform(CM_SHOWINGCHANGED,0,0); // This reasserts the visibility we want
  1722.       Memo.Refresh;
  1723.     end;
  1724.   end;
  1725. end;
  1726.  
  1727. function TMemoStrings.GetTextStr: string;
  1728. begin
  1729.   Result := Memo.Text;
  1730. end;
  1731.  
  1732. procedure TMemoStrings.SetTextStr(const Value: string);
  1733. var
  1734.   NewText: string;
  1735. begin
  1736.   NewText := AdjustLineBreaks(Value);
  1737.   if (Length(NewText) <> Memo.GetTextLen) or (NewText <> Memo.Text) then
  1738.   begin
  1739.     if SendMessage(Memo.Handle, WM_SETTEXT, 0, Longint(NewText)) = 0 then
  1740.       raise EInvalidOperation.Create(SInvalidMemoSize);
  1741.     Memo.Perform(CM_TEXTCHANGED, 0, 0);
  1742.   end;
  1743. end;
  1744.  
  1745. { TCustomMemo }
  1746.  
  1747. constructor TCustomMemo.Create(AOwner: TComponent);
  1748. begin
  1749.   inherited Create(AOwner);
  1750.   Width := 185;
  1751.   Height := 89;
  1752.   AutoSize := False;
  1753.   FWordWrap := True;
  1754.   FWantReturns := True;
  1755.   FLines := TMemoStrings.Create;
  1756.   TMemoStrings(FLines).Memo := Self;
  1757. end;
  1758.  
  1759. destructor TCustomMemo.Destroy;
  1760. begin
  1761.   FLines.Free;
  1762.   inherited Destroy;
  1763. end;
  1764.  
  1765. procedure TCustomMemo.CreateParams(var Params: TCreateParams);
  1766. const
  1767.   Alignments: array[TAlignment] of Longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
  1768.   ScrollBar: array[TScrollStyle] of LongInt = (0, WS_HSCROLL, WS_VSCROLL,
  1769.     WS_HSCROLL or WS_VSCROLL);
  1770.   WordWraps: array[Boolean] of LongInt = (0, ES_AUTOHSCROLL);
  1771. begin
  1772.   inherited CreateParams(Params);
  1773.   with Params do
  1774.   begin
  1775.     Style := Style and not WordWraps[FWordWrap] or ES_MULTILINE or
  1776.       Alignments[FAlignment] or ScrollBar[FScrollBars];
  1777.   end;
  1778. end;
  1779.  
  1780. procedure TCustomMemo.CreateWindowHandle(const Params: TCreateParams);
  1781. begin
  1782.   with Params do
  1783.   begin
  1784.     WindowHandle := CreateWindowEx(ExStyle, WinClassName, '', Style,
  1785.       X, Y, Width, Height, WndParent, 0, HInstance, Param);
  1786.     SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
  1787.   end;
  1788. end;
  1789.  
  1790. procedure TCustomMemo.Loaded;
  1791. begin
  1792.   inherited Loaded;
  1793.   Modified := False;
  1794. end;
  1795.  
  1796. procedure TCustomMemo.SetAlignment(Value: TAlignment);
  1797. begin
  1798.   if FAlignment <> Value then
  1799.   begin
  1800.     FAlignment := Value;
  1801.     RecreateWnd;
  1802.   end;
  1803. end;
  1804.  
  1805. procedure TCustomMemo.SetLines(Value: TStrings);
  1806. begin
  1807.   FLines.Assign(Value);
  1808. end;
  1809.  
  1810. procedure TCustomMemo.SetScrollBars(Value: TScrollStyle);
  1811. begin
  1812.   if FScrollBars <> Value then
  1813.   begin
  1814.     FScrollBars := Value;
  1815.     RecreateWnd;
  1816.   end;
  1817. end;
  1818.  
  1819. procedure TCustomMemo.SetWordWrap(Value: Boolean);
  1820. begin
  1821.   if Value <> FWordWrap then
  1822.   begin
  1823.     FWordWrap := Value;
  1824.     RecreateWnd;
  1825.   end;
  1826. end;
  1827.  
  1828. procedure TCustomMemo.WMGetDlgCode(var Message: TWMGetDlgCode);
  1829. begin
  1830.   inherited;
  1831.   if FWantTabs then Message.Result := Message.Result or DLGC_WANTTAB
  1832.   else Message.Result := Message.Result and not DLGC_WANTTAB;
  1833.   if not FWantReturns then
  1834.     Message.Result := Message.Result and not DLGC_WANTALLKEYS;
  1835. end;
  1836.  
  1837. procedure TCustomMemo.WMNCDestroy(var Message: TWMNCDestroy);
  1838. begin
  1839.   inherited;
  1840. end;
  1841.  
  1842. procedure TCustomMemo.KeyPress(var Key: Char);
  1843. begin
  1844.   inherited KeyPress(Key);
  1845.   if (Key = Char(VK_RETURN)) and not FWantReturns then Key := #0;
  1846. end;
  1847.  
  1848. { TComboBoxStrings }
  1849.  
  1850. function TComboBoxStrings.GetCount: Integer;
  1851. begin
  1852.   Result := SendMessage(ComboBox.Handle, CB_GETCOUNT, 0, 0);
  1853. end;
  1854.  
  1855. function TComboBoxStrings.Get(Index: Integer): string;
  1856. var
  1857.   Text: array[0..4095] of Char;
  1858.   Len: Integer;
  1859. begin
  1860.   Len := SendMessage(ComboBox.Handle, CB_GETLBTEXT, Index, Longint(@Text));
  1861.   if Len = CB_ERR then Len := 0;
  1862.   SetString(Result, Text, Len);
  1863. end;
  1864.  
  1865. function TComboBoxStrings.GetObject(Index: Integer): TObject;
  1866. begin
  1867.   Result := TObject(SendMessage(ComboBox.Handle, CB_GETITEMDATA, Index, 0));
  1868. end;
  1869.  
  1870. procedure TComboBoxStrings.PutObject(Index: Integer; AObject: TObject);
  1871. begin
  1872.   SendMessage(ComboBox.Handle, CB_SETITEMDATA, Index, Longint(AObject));
  1873. end;
  1874.  
  1875. function TComboBoxStrings.Add(const S: string): Integer;
  1876. begin
  1877.   Result := SendMessage(ComboBox.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
  1878.   if Result < 0 then
  1879.     raise EOutOfResources.Create(SInsertLineError);
  1880. end;
  1881.  
  1882. procedure TComboBoxStrings.Insert(Index: Integer; const S: string);
  1883. begin
  1884.   if SendMessage(ComboBox.Handle, CB_INSERTSTRING, Index,
  1885.     Longint(PChar(S))) < 0 then
  1886.     raise EOutOfResources.Create(SInsertLineError);
  1887. end;
  1888.  
  1889. procedure TComboBoxStrings.Delete(Index: Integer);
  1890. begin
  1891.   SendMessage(ComboBox.Handle, CB_DELETESTRING, Index, 0);
  1892. end;
  1893.  
  1894. procedure TComboBoxStrings.Clear;
  1895. var
  1896.   S: string;
  1897. begin
  1898.   S := ComboBox.Text;
  1899.   SendMessage(ComboBox.Handle, CB_RESETCONTENT, 0, 0);
  1900.   ComboBox.Text := S;
  1901.   ComboBox.Update;
  1902. end;
  1903.  
  1904. procedure TComboBoxStrings.SetUpdateState(Updating: Boolean);
  1905. begin
  1906.   SendMessage(ComboBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  1907.   if not Updating then ComboBox.Refresh;
  1908. end;
  1909.  
  1910. { TCustomComboBox }
  1911.  
  1912. constructor TCustomComboBox.Create(AOwner: TComponent);
  1913. const
  1914.   ComboBoxStyle = [csCaptureMouse, csSetCaption, csDoubleClicks,
  1915.     csFixedHeight];
  1916. begin
  1917.   inherited Create(AOwner);
  1918.   if NewStyleControls then
  1919.     ControlStyle := ComboBoxStyle else
  1920.     ControlStyle := ComboBoxStyle + [csFramed];
  1921.   Width := 145;
  1922.   Height := 25;
  1923.   TabStop := True;
  1924.   ParentColor := False;
  1925.   FItems := TComboBoxStrings.Create;
  1926.   TComboBoxStrings(FItems).ComboBox := Self;
  1927.   FCanvas := TControlCanvas.Create;
  1928.   FItemHeight := 16;
  1929.   FStyle := csDropDown;
  1930.   FEditInstance := MakeObjectInstance(EditWndProc);
  1931.   FListInstance := MakeObjectInstance(ListWndProc);
  1932.   FDropDownCount := 8;
  1933. end;
  1934.  
  1935. destructor TCustomComboBox.Destroy;
  1936. begin
  1937.   if HandleAllocated then DestroyWindowHandle;
  1938.   FreeObjectInstance(FListInstance);
  1939.   FreeObjectInstance(FEditInstance);
  1940.   FCanvas.Free;
  1941.   FItems.Free;
  1942.   FSaveItems.Free;
  1943.   inherited Destroy;
  1944. end;
  1945.  
  1946. procedure TCustomComboBox.Clear;
  1947. begin
  1948.   SetTextBuf('');
  1949.   FItems.Clear;
  1950. end;
  1951.  
  1952. procedure TCustomComboBox.SelectAll;
  1953. begin
  1954.   SendMessage(Handle, CB_SETEDITSEL, 1, $FFFF0000);
  1955. end;
  1956.  
  1957. function TCustomComboBox.GetDroppedDown: Boolean;
  1958. begin
  1959.   Result := LongBool(SendMessage(Handle, CB_GETDROPPEDSTATE, 0, 0));
  1960. end;
  1961.  
  1962. procedure TCustomComboBox.SetDroppedDown(Value: Boolean);
  1963. begin
  1964.   SendMessage(Handle, CB_SHOWDROPDOWN, Longint(Value), 0);
  1965. end;
  1966.  
  1967. function TCustomComboBox.GetItemIndex: Integer;
  1968. begin
  1969.   Result := SendMessage(Handle, CB_GETCURSEL, 0, 0);
  1970. end;
  1971.  
  1972. procedure TCustomComboBox.SetItemIndex(Value: Integer);
  1973. begin
  1974.   SendMessage(Handle, CB_SETCURSEL, Value, 0);
  1975. end;
  1976.  
  1977. function TCustomComboBox.GetSelStart: Integer;
  1978. begin
  1979.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Result), 0);
  1980. end;
  1981.  
  1982. procedure TCustomComboBox.SetSelStart(Value: Integer);
  1983. var
  1984.   Selection: TSelection;
  1985. begin
  1986.   Selection.StartPos := Value;
  1987.   Selection.EndPos := Value;
  1988.   SendMessage(Handle, CB_SETEDITSEL, Selection.StartPos, Selection.EndPos);
  1989. end;
  1990.  
  1991. function TCustomComboBox.GetSelLength: Integer;
  1992. var
  1993.   Selection: TSelection;
  1994. begin
  1995.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Selection.StartPos),
  1996.     Longint(@Selection.EndPos));
  1997.   Result := Selection.EndPos - Selection.StartPos;
  1998. end;
  1999.  
  2000. procedure TCustomComboBox.SetSelLength(Value: Integer);
  2001. var
  2002.   Selection: TSelection;
  2003. begin
  2004.   SendMessage(Handle, CB_GETEDITSEL, Longint(@Selection.StartPos),
  2005.     Longint(@Selection.EndPos));
  2006.   Selection.EndPos := Selection.StartPos + Value;
  2007.   SendMessage(Handle, CB_SETEDITSEL, Selection.StartPos, Selection.EndPos);
  2008. end;
  2009.  
  2010. function TCustomComboBox.GetSelText: string;
  2011. begin
  2012.   Result := '';
  2013.   if FStyle < csDropDownList then
  2014.     Result := Copy(Text, GetSelStart + 1, GetSelLength);
  2015. end;
  2016.  
  2017. procedure TCustomComboBox.SetSelText(const Value: string);
  2018. begin
  2019.   if FStyle < csDropDownList then
  2020.   begin
  2021.     HandleNeeded;
  2022.     SendMessage(FEditHandle, EM_REPLACESEL, 0, Longint(PChar(Value)));
  2023.   end;
  2024. end;
  2025.  
  2026. procedure TCustomComboBox.SetMaxLength(Value: Integer);
  2027. begin
  2028.   if FMaxLength <> Value then
  2029.   begin
  2030.     FMaxLength := Value;
  2031.     if HandleAllocated then SendMessage(Handle, CB_LIMITTEXT, Value, 0);
  2032.   end;
  2033. end;
  2034.  
  2035. procedure TCustomComboBox.SetSorted(Value: Boolean);
  2036. begin
  2037.   if FSorted <> Value then
  2038.   begin
  2039.     FSorted := Value;
  2040.     RecreateWnd;
  2041.   end;
  2042. end;
  2043.  
  2044. procedure TCustomComboBox.SetStyle(Value: TComboBoxStyle);
  2045. begin
  2046.   if FStyle <> Value then
  2047.   begin
  2048.     FStyle := Value;
  2049.     if Value = csSimple then
  2050.       ControlStyle := ControlStyle - [csFixedHeight] else
  2051.       ControlStyle := ControlStyle + [csFixedHeight];
  2052.     RecreateWnd;
  2053.   end;
  2054. end;
  2055.  
  2056. function TCustomComboBox.GetItemHeight: Integer;
  2057. begin
  2058.   if FStyle in [csOwnerDrawFixed, csOwnerDrawVariable] then
  2059.     Result := FItemHeight else
  2060.     Result := Perform(CB_GETITEMHEIGHT, 0, 0);
  2061. end;
  2062.  
  2063. procedure TCustomComboBox.SetItemHeight(Value: Integer);
  2064. begin
  2065.   if Value > 0 then FItemHeight := Value;
  2066. end;
  2067.  
  2068. procedure TCustomComboBox.SetItems(Value: TStrings);
  2069. begin
  2070.   Items.Assign(Value);
  2071. end;
  2072.  
  2073. procedure TCustomComboBox.CreateParams(var Params: TCreateParams);
  2074. const
  2075.   ComboBoxStyles: array[TComboBoxStyle] of Longint = (
  2076.     CBS_DROPDOWN, CBS_SIMPLE, CBS_DROPDOWNLIST,
  2077.     CBS_DROPDOWNLIST or CBS_OWNERDRAWFIXED,
  2078.     CBS_DROPDOWNLIST or CBS_OWNERDRAWVARIABLE);
  2079.   Sorts: array[Boolean] of Longint = (0, CBS_SORT);
  2080. begin
  2081.   inherited CreateParams(Params);
  2082.   CreateSubClass(Params, 'COMBOBOX');
  2083.   with Params do
  2084.   begin
  2085.     Style := Style or (WS_VSCROLL or CBS_HASSTRINGS or CBS_AUTOHSCROLL) or
  2086.       ComboBoxStyles[FStyle] or Sorts[FSorted];
  2087.     if NewStyleControls and Ctl3D then
  2088.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  2089.   end;
  2090. end;
  2091.  
  2092. procedure TCustomComboBox.CreateWnd;
  2093. var
  2094.   ChildHandle: THandle;
  2095.   MaxChars: Integer;
  2096. begin
  2097.   inherited CreateWnd;
  2098.   MaxChars := FMaxLength;
  2099.   if (MaxChars <= 0) or (MaxChars > 255) then MaxChars := 255;
  2100.   SendMessage(Handle, CB_LIMITTEXT, MaxChars, 0);
  2101.   if FSaveItems <> nil then
  2102.   begin
  2103.     FItems.Assign(FSaveItems);
  2104.     FSaveItems.Free;
  2105.     FSaveItems := nil;
  2106.   end;
  2107.   FEditHandle := 0;
  2108.   FListHandle := 0;
  2109.   if FStyle in [csDropDown, csSimple] then
  2110.   begin
  2111.     ChildHandle := GetWindow(Handle, GW_CHILD);
  2112.     if ChildHandle <> 0 then
  2113.     begin
  2114.       if FStyle = csSimple then
  2115.       begin
  2116.         FListHandle := ChildHandle;
  2117.         FDefListProc := Pointer(GetWindowLong(FListHandle, GWL_WNDPROC));
  2118.         SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FListInstance));
  2119.         ChildHandle := GetWindow(ChildHandle, GW_HWNDNEXT);
  2120.       end;
  2121.       FEditHandle := ChildHandle;
  2122.       FDefEditProc := Pointer(GetWindowLong(FEditHandle, GWL_WNDPROC));
  2123.       SetWindowLong(FEditHandle, GWL_WNDPROC, Longint(FEditInstance));
  2124.     end;
  2125.   end;
  2126.   if NewStyleControls and (FEditHandle <> 0) then
  2127.     SendMessage(FEditHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  2128. end;
  2129.  
  2130. procedure TCustomComboBox.DestroyWnd;
  2131. begin
  2132.   if FItems.Count > 0 then
  2133.   begin
  2134.     FSaveItems := TStringList.Create;
  2135.     FSaveItems.Assign(FItems);
  2136.   end;
  2137.   inherited DestroyWnd;
  2138. end;
  2139.  
  2140. procedure TCustomComboBox.WMCreate(var Message: TWMCreate);
  2141. begin
  2142.   inherited;
  2143.   SetWindowText(Handle, WindowText);
  2144. end;
  2145.  
  2146. procedure TCustomComboBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  2147. begin
  2148.   if Style = csSimple then
  2149.   begin
  2150.     FillRect(Message.DC, ClientRect, Parent.Brush.Handle);
  2151.     Message.Result := 1;
  2152.   end
  2153.   else
  2154.     DefaultHandler(Message);
  2155. end;
  2156.  
  2157. procedure TCustomComboBox.WMDrawItem(var Message: TWMDrawItem);
  2158. begin
  2159.   DefaultHandler(Message);
  2160. end;
  2161.  
  2162. procedure TCustomComboBox.WMMeasureItem(var Message: TWMMeasureItem);
  2163. begin
  2164.   DefaultHandler(Message);
  2165. end;
  2166.  
  2167. procedure TCustomComboBox.WMDeleteItem(var Message: TWMDeleteItem);
  2168. begin
  2169.   DefaultHandler(Message);
  2170. end;
  2171.  
  2172. procedure TCustomComboBox.WMGetDlgCode(var Message: TWMGetDlgCode);
  2173. begin
  2174.   inherited;
  2175.   if DroppedDown then Message.Result := Message.Result or DLGC_WANTALLKEYS;
  2176. end;
  2177.  
  2178. procedure TCustomComboBox.CMCancelMode(var Message: TCMCancelMode);
  2179. begin
  2180.   if Message.Sender <> Self then Perform(CB_SHOWDROPDOWN, 0, 0);
  2181. end;
  2182.  
  2183. procedure TCustomComboBox.CMCtl3DChanged(var Message: TMessage);
  2184. begin
  2185.   if NewStyleControls then RecreateWnd;
  2186.   inherited;
  2187. end;
  2188.  
  2189. procedure TCustomComboBox.CMParentColorChanged(var Message: TMessage);
  2190. begin
  2191.   inherited;
  2192.   if not NewStyleControls and (Style < csDropDownList) then Invalidate;
  2193. end;
  2194.  
  2195. procedure TCustomComboBox.EditWndProc(var Message: TMessage);
  2196. var
  2197.   P: TPoint;
  2198. begin
  2199.   if Message.Msg = WM_SYSCOMMAND then
  2200.   begin
  2201.     WndProc(Message);
  2202.     Exit;
  2203.   end;
  2204.   ComboWndProc(Message, FEditHandle, FDefEditProc);
  2205.   case Message.Msg of
  2206.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  2207.       begin
  2208.         if DragMode = dmAutomatic then
  2209.         begin
  2210.           GetCursorPos(P);
  2211.           P := ScreenToClient(P);
  2212.           SendMessage(FEditHandle, WM_LBUTTONUP, 0,Longint(PointToSmallPoint(P)));
  2213.           BeginDrag(False);
  2214.         end;
  2215.       end;
  2216.     WM_SETFONT:
  2217.       if NewStyleControls then
  2218.         SendMessage(FEditHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
  2219.   end;
  2220. end;
  2221.  
  2222. procedure TCustomComboBox.ListWndProc(var Message: TMessage);
  2223. begin
  2224.   ComboWndProc(Message, FListHandle, FDefListProc);
  2225. end;
  2226.  
  2227. procedure TCustomComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  2228.   ComboProc: Pointer);
  2229. var
  2230.   Point: TPoint;
  2231. begin
  2232.   try
  2233.     with Message do
  2234.     begin
  2235.       case Msg of
  2236.         WM_SETFOCUS:
  2237.           if not GetParentForm(Self).SetFocusedControl(Self) then Exit;
  2238.         WM_KILLFOCUS:
  2239.           if csFocusing in ControlState then Exit;
  2240.         WM_KEYDOWN, WM_SYSKEYDOWN:
  2241.           if (ComboWnd <> FListHandle) and DoKeyDown(TWMKey(Message)) then
  2242.             Exit;
  2243.         WM_CHAR:
  2244.           begin
  2245.             if DoKeyPress(TWMKey(Message)) then Exit;
  2246.             if ((TWMKey(Message).CharCode = VK_RETURN) or
  2247.               (TWMKey(Message).CharCode = VK_ESCAPE)) and DroppedDown then
  2248.             begin
  2249.               DroppedDown := False;
  2250.               Exit;
  2251.             end;
  2252.           end;
  2253.         WM_KEYUP, WM_SYSKEYUP:
  2254.           if DoKeyUp(TWMKey(Message)) then Exit;
  2255.         WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);
  2256.         WM_RBUTTONUP:
  2257.           if HasPopup(Self) then
  2258.           begin
  2259.             with TWMRButtonUp(Message) do
  2260.             begin
  2261.               Point.X := Pos.X;
  2262.               Point.Y := Pos.Y;
  2263.               MapWindowPoints(ComboWnd, Handle, Point, 1);
  2264.               Pos.X := Point.X;
  2265.               Pos.Y := Point.Y;
  2266.             end;
  2267.             WndProc(Message);
  2268.             Exit;
  2269.           end;
  2270.         WM_GETDLGCODE:
  2271.           if DroppedDown then
  2272.           begin
  2273.             Result := DLGC_WANTALLKEYS;
  2274.             Exit;
  2275.           end;
  2276.         WM_NCHITTEST:
  2277.           if csDesigning in ComponentState then
  2278.           begin
  2279.             Result := HTTRANSPARENT;
  2280.             Exit;
  2281.           end;
  2282.         CN_KEYDOWN, CN_CHAR, CN_SYSKEYDOWN, CN_SYSCHAR:
  2283.           begin
  2284.             WndProc(Message);
  2285.             Exit;
  2286.           end;
  2287.       end;
  2288.       Result := CallWindowProc(ComboProc, ComboWnd, Msg, WParam, LParam);
  2289.       if (Msg = WM_LBUTTONDBLCLK) and (csDoubleClicks in ControlStyle) then
  2290.         DblClick;
  2291.     end;
  2292.   except
  2293.     Application.HandleException(Self);
  2294.   end;
  2295. end;
  2296.  
  2297. procedure TCustomComboBox.WndProc(var Message: TMessage);
  2298. begin
  2299.     {for auto drag mode, let listbox handle itself, instead of TControl}
  2300.   if not (csDesigning in ComponentState) and
  2301.      ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
  2302.      not Dragging then
  2303.   begin
  2304.     if DragMode = dmAutomatic then
  2305.     begin
  2306.       if IsControlMouseMsg(TWMMouse(Message)) then
  2307.         Exit;
  2308.       ControlState := ControlState + [csLButtonDown];
  2309.       Dispatch(Message);  {overrides TControl's BeginDrag}
  2310.       Exit;
  2311.     end;
  2312.   end;
  2313.   with Message do
  2314.     case Msg of
  2315.       WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
  2316.         begin
  2317.           SetTextColor(WParam, ColorToRGB(Font.Color));
  2318.           SetBkColor(WParam, ColorToRGB(Brush.Color));
  2319.           Result := Brush.Handle;
  2320.           Exit;
  2321.         end;
  2322.       CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
  2323.         if not NewStyleControls and (Style < csDropDownList) then
  2324.         begin
  2325.           Result := Parent.Brush.Handle;
  2326.           Exit;
  2327.         end;
  2328.       WM_CHAR:
  2329.         begin
  2330.           if DoKeyPress(TWMKey(Message)) then Exit;
  2331.           if ((TWMKey(Message).CharCode = VK_RETURN) or
  2332.             (TWMKey(Message).CharCode = VK_ESCAPE)) and DroppedDown then
  2333.           begin
  2334.             DroppedDown := False;
  2335.             Exit;
  2336.           end;
  2337.         end;
  2338.     end;
  2339.   inherited WndProc(Message);
  2340. end;
  2341.  
  2342. procedure TCustomComboBox.AdjustDropDown;
  2343. var
  2344.   ItemCount: Integer;
  2345. begin
  2346.   ItemCount := FItems.Count;
  2347.   if ItemCount > DropDownCount then ItemCount := DropDownCount;
  2348.   if ItemCount < 1 then ItemCount := 1;
  2349.   SetWindowPos(Handle, 0, 0, 0, Width, ItemHeight * ItemCount +
  2350.     Height + 2, SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW +
  2351.     SWP_HIDEWINDOW);
  2352.   SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE +
  2353.     SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW + SWP_SHOWWINDOW);
  2354. end;
  2355.  
  2356. procedure TCustomComboBox.CNCommand(var Message: TWMCommand);
  2357. begin
  2358.   case Message.NotifyCode of
  2359.     CBN_DBLCLK:
  2360.       DblClick;
  2361.     CBN_EDITCHANGE:
  2362.       Change;
  2363.     CBN_DROPDOWN:
  2364.       begin
  2365.         FFocusChanged := False;
  2366.         DropDown;
  2367.         AdjustDropDown;
  2368.         if FFocusChanged then
  2369.         begin
  2370.           PostMessage(Handle, WM_CANCELMODE, 0, 0);
  2371.           if not FIsFocused then PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
  2372.         end;
  2373.       end;
  2374.     CBN_SELCHANGE:
  2375.       begin
  2376.         Text := Items[ItemIndex];
  2377.         Click;
  2378.         Change;
  2379.       end;
  2380.     CBN_SETFOCUS:
  2381.       begin
  2382.         FIsFocused := True;
  2383.         FFocusChanged := True;
  2384.         SetIme;
  2385.       end;
  2386.     CBN_KILLFOCUS:
  2387.       begin
  2388.         FIsFocused := False;
  2389.         FFocusChanged := True;
  2390.         ResetIme;
  2391.       end;
  2392.   end;
  2393. end;
  2394.  
  2395. procedure TCustomComboBox.Change;
  2396. begin
  2397.   inherited Changed;
  2398.   if Assigned(FOnChange) then FOnChange(Self);
  2399. end;
  2400.  
  2401. procedure TCustomComboBox.DrawItem(Index: Integer; Rect: TRect;
  2402.   State: TOwnerDrawState);
  2403. begin
  2404.   if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State)
  2405.   else
  2406.   begin
  2407.     FCanvas.FillRect(Rect);
  2408.     FCanvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
  2409.   end;
  2410. end;
  2411.  
  2412. procedure TCustomComboBox.DropDown;
  2413. begin
  2414.   if Assigned(FOnDropDown) then FOnDropDown(Self);
  2415. end;
  2416.  
  2417. procedure TCustomComboBox.MeasureItem(Index: Integer; var Height: Integer);
  2418. begin
  2419.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
  2420. end;
  2421.  
  2422. procedure TCustomComboBox.CNDrawItem(var Message: TWMDrawItem);
  2423. var
  2424.   State: TOwnerDrawState;
  2425. begin
  2426.   with Message.DrawItemStruct^ do
  2427.   begin
  2428.     State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  2429.     FCanvas.Handle := hDC;
  2430.     FCanvas.Font := Font;
  2431.     FCanvas.Brush := Brush;
  2432.     if (Integer(itemID) >= 0) and (odSelected in State) then
  2433.     begin
  2434.       FCanvas.Brush.Color := clHighlight;
  2435.       FCanvas.Font.Color := clHighlightText
  2436.     end;
  2437.     if Integer(itemID) >= 0 then
  2438.       DrawItem(itemID, rcItem, State) else
  2439.       FCanvas.FillRect(rcItem);
  2440.     if odFocused in State then DrawFocusRect(hDC, rcItem);
  2441.     FCanvas.Handle := 0;
  2442.   end;
  2443. end;
  2444.  
  2445. procedure TCustomComboBox.CNMeasureItem(var Message: TWMMeasureItem);
  2446. begin
  2447.   with Message.MeasureItemStruct^ do
  2448.   begin
  2449.     itemHeight := FItemHeight;
  2450.     if FStyle = csOwnerDrawVariable then
  2451.       MeasureItem(itemID, Integer(itemHeight));
  2452.   end;
  2453. end;
  2454.  
  2455. procedure TCustomComboBox.WMLButtonDown(var Message: TWMLButtonDown);
  2456. begin
  2457.   if (DragMode = dmAutomatic) and (Style = csDropDownList) and
  2458.       (Message.XPos < (Width - GetSystemMetrics(SM_CXHSCROLL))) then
  2459.   begin
  2460.     SetFocus;
  2461.     BeginDrag(False);
  2462.     Exit;
  2463.   end;
  2464.   inherited;
  2465.   if MouseCapture and (ValidParentForm(Self).ActiveControl <> Self) then
  2466.     MouseCapture := False;
  2467. end;
  2468.  
  2469. { TButtonControl }
  2470.  
  2471. procedure TButtonControl.WndProc(var Message: TMessage);
  2472. begin
  2473.   case Message.Msg of
  2474.     WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  2475.       if not (csDesigning in ComponentState) and not Focused then
  2476.       begin
  2477.         FClicksDisabled := True;
  2478.         Windows.SetFocus(Handle);
  2479.         FClicksDisabled := False;
  2480.         if not Focused then Exit;
  2481.       end;
  2482.     CN_COMMAND:
  2483.       if FClicksDisabled then Exit;
  2484.   end;
  2485.   inherited WndProc(Message);
  2486. end;
  2487.  
  2488. { TButton }
  2489.  
  2490. constructor TButton.Create(AOwner: TComponent);
  2491. begin
  2492.   inherited Create(AOwner);
  2493.   ControlStyle := [csSetCaption, csOpaque, csDoubleClicks];
  2494.   Width := 75;
  2495.   Height := 25;
  2496.   TabStop := True;
  2497. end;
  2498.  
  2499. procedure TButton.Click;
  2500. var
  2501.   Form: TCustomForm;
  2502. begin
  2503.   Form := GetParentForm(Self);
  2504.   if Form <> nil then Form.ModalResult := ModalResult;
  2505.   inherited Click;
  2506. end;
  2507.  
  2508. procedure TButton.SetButtonStyle(ADefault: Boolean);
  2509. const
  2510.   BS_MASK = $000F;
  2511. var
  2512.   Style: Word;
  2513. begin
  2514.   if HandleAllocated then
  2515.   begin
  2516.     if ADefault then Style := BS_DEFPUSHBUTTON else Style := BS_PUSHBUTTON;
  2517.     if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
  2518.       SendMessage(Handle, BM_SETSTYLE, Style, 1);
  2519.   end;
  2520. end;
  2521.  
  2522. procedure TButton.SetDefault(Value: Boolean);
  2523. begin
  2524.   FDefault := Value;
  2525.   if HandleAllocated then
  2526.     with GetParentForm(Self) do
  2527.       Perform(CM_FOCUSCHANGED, 0, Longint(ActiveControl));
  2528. end;
  2529.  
  2530. procedure TButton.CreateParams(var Params: TCreateParams);
  2531. const
  2532.   ButtonStyles: array[Boolean] of LongInt = (BS_PUSHBUTTON, BS_DEFPUSHBUTTON);
  2533. begin
  2534.   inherited CreateParams(Params);
  2535.   CreateSubClass(Params, 'BUTTON');
  2536.   Params.Style := Params.Style or ButtonStyles[FDefault];
  2537. end;
  2538.  
  2539. procedure TButton.CreateWnd;
  2540. begin
  2541.   inherited CreateWnd;
  2542.   FActive := FDefault;
  2543. end;
  2544.  
  2545. procedure TButton.CNCommand(var Message: TWMCommand);
  2546. begin
  2547.   if Message.NotifyCode = BN_CLICKED then Click;
  2548. end;
  2549.  
  2550. procedure TButton.CMDialogKey(var Message: TCMDialogKey);
  2551. begin
  2552.   with Message do
  2553.     if  (((CharCode = VK_RETURN) and FActive) or
  2554.       ((CharCode = VK_ESCAPE) and FCancel)) and
  2555.       (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then
  2556.     begin
  2557.       Click;
  2558.       Result := 1;
  2559.     end else
  2560.       inherited;
  2561. end;
  2562.  
  2563. procedure TButton.CMDialogChar(var Message: TCMDialogChar);
  2564. begin
  2565.   with Message do
  2566.     if IsAccel(CharCode, Caption) and CanFocus then
  2567.     begin
  2568.       Click;
  2569.       Result := 1;
  2570.     end else
  2571.       inherited;
  2572. end;
  2573.  
  2574. procedure TButton.CMFocusChanged(var Message: TCMFocusChanged);
  2575. begin
  2576.   with Message do
  2577.     if Sender is TButton then
  2578.       FActive := Sender = Self
  2579.     else
  2580.       FActive := FDefault;
  2581.   SetButtonStyle(FActive);
  2582.   inherited;
  2583. end;
  2584.  
  2585. procedure TButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  2586. begin
  2587.   DefaultHandler(Message);
  2588. end;
  2589.  
  2590. { TCustomCheckBox }
  2591.  
  2592. constructor TCustomCheckBox.Create(AOwner: TComponent);
  2593. begin
  2594.   inherited Create(AOwner);
  2595.   Width := 97;
  2596.   Height := 17;
  2597.   TabStop := True;
  2598.   ControlStyle := [csSetCaption, csDoubleClicks];
  2599.   FAlignment := taRightJustify;
  2600.   FState := cbUnchecked;
  2601. end;
  2602.  
  2603. procedure TCustomCheckBox.Toggle;
  2604. begin
  2605.   case State of
  2606.     cbUnchecked:
  2607.       if AllowGrayed then State := cbGrayed else State := cbChecked;
  2608.     cbChecked: State := cbUnchecked;
  2609.     cbGrayed: State := cbChecked;
  2610.   end;
  2611. end;
  2612.  
  2613. procedure TCustomCheckBox.Click;
  2614. begin
  2615.   inherited Changed;
  2616.   inherited Click;
  2617. end;
  2618.  
  2619. function TCustomCheckBox.GetChecked: Boolean;
  2620. begin
  2621.   Result := State = cbChecked;
  2622. end;
  2623.  
  2624. procedure TCustomCheckBox.SetAlignment(Value: TLeftRight);
  2625. begin
  2626.   if FAlignment <> Value then
  2627.   begin
  2628.     FAlignment := Value;
  2629.     RecreateWnd;
  2630.   end;
  2631. end;
  2632.  
  2633. procedure TCustomCheckBox.SetChecked(Value: Boolean);
  2634. begin
  2635.   if Value then State := cbChecked else State := cbUnchecked;
  2636. end;
  2637.  
  2638. procedure TCustomCheckBox.SetState(Value: TCheckBoxState);
  2639. begin
  2640.   if FState <> Value then
  2641.   begin
  2642.     FState := Value;
  2643.     if HandleAllocated then
  2644.       SendMessage(Handle, BM_SETCHECK, Integer(FState), 0);
  2645.     Click;
  2646.   end;
  2647. end;
  2648.  
  2649. procedure TCustomCheckBox.CreateParams(var Params: TCreateParams);
  2650. const
  2651.   Alignments: array[TLeftRight] of LongInt = (BS_LEFTTEXT, 0);
  2652. begin
  2653.   inherited CreateParams(Params);
  2654.   CreateSubClass(Params, 'BUTTON');
  2655.   with Params do
  2656.   begin
  2657.     Style := Style or BS_3STATE or Alignments[FAlignment];
  2658.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  2659.   end;
  2660. end;
  2661.  
  2662. procedure TCustomCheckBox.CreateWnd;
  2663. begin
  2664.   inherited CreateWnd;
  2665.   SendMessage(Handle, BM_SETCHECK, Integer(FState), 0);
  2666. end;
  2667.  
  2668. procedure TCustomCheckBox.CreateWindowHandle(const Params: TCreateParams);
  2669. begin
  2670.   if Ctl3D and not NewStyleControls then
  2671.   begin      // special subclassing required by unicode Ctl3D on NT
  2672.     with Params do
  2673.       WindowHandle := CreateWindowEx(ExStyle, 'BUTTON', Caption, Style,
  2674.         X, Y, Width, Height, WndParent, 0, HInstance, Param);
  2675.     Subclass3DWnd(WindowHandle);
  2676.     DefWndProc := Pointer(GetWindowLong(WindowHandle, GWL_WNDPROC));
  2677.     CreationControl := Self;
  2678.     SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(@InitWndProc));
  2679.     SendMessage(WindowHandle, WM_NULL, 0, 0);
  2680.   end
  2681.   else
  2682.     inherited CreateWindowHandle(Params);
  2683. end;
  2684.  
  2685. procedure TCustomCheckBox.WMSize(var Message: TMessage);
  2686. begin
  2687.   inherited;
  2688.   Invalidate;
  2689. end;
  2690.  
  2691. procedure TCustomCheckBox.CMCtl3DChanged(var Message: TMessage);
  2692. begin
  2693.   RecreateWnd;
  2694. end;
  2695.  
  2696. procedure TCustomCheckBox.CMDialogChar(var Message: TCMDialogChar);
  2697. begin
  2698.   with Message do
  2699.     if IsAccel(CharCode, Caption) and CanFocus then
  2700.     begin
  2701.       SetFocus;
  2702.       if Focused then Toggle;
  2703.       Result := 1;
  2704.     end else
  2705.       inherited;
  2706. end;
  2707.  
  2708. procedure TCustomCheckBox.CNCommand(var Message: TWMCommand);
  2709. begin
  2710.   if Message.NotifyCode = BN_CLICKED then Toggle;
  2711. end;
  2712.  
  2713. procedure TCustomCheckBox.WMSetFocus(var Message: TWMSetFocus);
  2714. begin // fix double focus rect drawing bug in Ctl3D when switching notebook pages
  2715.   if Ctl3D and not NewStyleControls then  UpdateWindow(Handle);
  2716.   inherited;
  2717. end;
  2718.  
  2719. { TRadioButton }
  2720.  
  2721. constructor TRadioButton.Create(AOwner: TComponent);
  2722. begin
  2723.   inherited Create(AOwner);
  2724.   Width := 113;
  2725.   Height := 17;
  2726.   ControlStyle := [csSetCaption, csDoubleClicks];
  2727.   FAlignment := taRightJustify;
  2728. end;
  2729.  
  2730. procedure TRadioButton.SetAlignment(Value: TLeftRight);
  2731. begin
  2732.   if FAlignment <> Value then
  2733.   begin
  2734.     FAlignment := Value;
  2735.     RecreateWnd;
  2736.   end;
  2737. end;
  2738.  
  2739. procedure TRadioButton.SetChecked(Value: Boolean);
  2740.  
  2741.   procedure TurnSiblingsOff;
  2742.   var
  2743.     I: Integer;
  2744.     Sibling: TControl;
  2745.   begin
  2746.     if Parent <> nil then
  2747.       with Parent do
  2748.         for I := 0 to ControlCount - 1 do
  2749.         begin
  2750.           Sibling := Controls[I];
  2751.           if (Sibling <> Self) and (Sibling is TRadioButton) then
  2752.             TRadioButton(Sibling).SetChecked(False);
  2753.         end;
  2754.   end;
  2755.  
  2756. begin
  2757.   if FChecked <> Value then
  2758.   begin
  2759.     FChecked := Value;
  2760.     TabStop := Value;
  2761.     if HandleAllocated then
  2762.       SendMessage(Handle, BM_SETCHECK, Integer(Checked), 0);
  2763.     if Value then
  2764.     begin
  2765.       TurnSiblingsOff;
  2766.       inherited Changed;
  2767.       Click;
  2768.     end;
  2769.   end;
  2770. end;
  2771.  
  2772. procedure TRadioButton.CreateParams(var Params: TCreateParams);
  2773. const
  2774.   Alignments: array[TLeftRight] of LongInt = (BS_LEFTTEXT, 0);
  2775. begin
  2776.   inherited CreateParams(Params);
  2777.   CreateSubClass(Params, 'BUTTON');
  2778.   with Params do
  2779.   begin
  2780.     Style := Style or BS_RADIOBUTTON or Alignments[FAlignment];
  2781.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  2782.   end;
  2783. end;
  2784.  
  2785. procedure TRadioButton.CreateWnd;
  2786. begin
  2787.   inherited CreateWnd;
  2788.   SendMessage(Handle, BM_SETCHECK, Integer(FChecked), 0);
  2789. end;
  2790.  
  2791. procedure TRadioButton.CreateWindowHandle(const Params: TCreateParams);
  2792. begin
  2793.   if Ctl3D and not NewStyleControls then
  2794.   begin      // special subclassing required by unicode Ctl3D on NT
  2795.     with Params do
  2796.       WindowHandle := CreateWindowEx(ExStyle, 'BUTTON', Caption, Style,
  2797.         X, Y, Width, Height, WndParent, 0, HInstance, Param);
  2798.     Subclass3DWnd(WindowHandle);
  2799.     DefWndProc := Pointer(GetWindowLong(WindowHandle, GWL_WNDPROC));
  2800.     CreationControl := Self;
  2801.     SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(@InitWndProc));
  2802.     SendMessage(WindowHandle, WM_NULL, 0, 0);
  2803.   end
  2804.   else
  2805.     inherited CreateWindowHandle(Params);
  2806. end;
  2807.  
  2808. procedure TRadioButton.CMCtl3DChanged(var Message: TMessage);
  2809. begin
  2810.   RecreateWnd;
  2811. end;
  2812.  
  2813. procedure TRadioButton.CMDialogChar(var Message: TCMDialogChar);
  2814. begin
  2815.   with Message do
  2816.     if IsAccel(Message.CharCode, Caption) and CanFocus then
  2817.     begin
  2818.       SetFocus;
  2819.       Result := 1;
  2820.     end else
  2821.       inherited;
  2822. end;
  2823.  
  2824. procedure TRadioButton.CNCommand(var Message: TWMCommand);
  2825. begin
  2826.   case Message.NotifyCode of
  2827.     BN_CLICKED: SetChecked(True);
  2828.     BN_DOUBLECLICKED: DblClick;
  2829.   end;
  2830. end;
  2831.  
  2832. procedure TRadioButton.WMSetFocus(var Message: TWMSetFocus);
  2833. begin // fix double focus rect drawing bug in Ctl3D when switching notebook pages
  2834.   if Ctl3D and not NewStyleControls then  UpdateWindow(Handle);
  2835.   inherited;
  2836. end;
  2837.  
  2838.  
  2839. { TListBoxStrings }
  2840.  
  2841. function TListBoxStrings.GetCount: Integer;
  2842. begin
  2843.   Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
  2844. end;
  2845.  
  2846. function TListBoxStrings.Get(Index: Integer): string;
  2847. var
  2848.   Len: Integer;
  2849.   Text: array[0..4095] of Char;
  2850. begin
  2851.   Len := SendMessage(ListBox.Handle, LB_GETTEXT, Index, Longint(@Text));
  2852.   if Len < 0 then Error(SListIndexError, Index);
  2853.   SetString(Result, Text, Len);
  2854. end;
  2855.  
  2856. function TListBoxStrings.GetObject(Index: Integer): TObject;
  2857. begin
  2858.   Result := TObject(ListBox.GetItemData( Index ));
  2859.   if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
  2860. end;
  2861.  
  2862. procedure TListBoxStrings.PutObject(Index: Integer; AObject: TObject);
  2863. begin
  2864.   ListBox.SetItemData( Index, LongInt(AObject) );
  2865. end;
  2866.  
  2867. function TListBoxStrings.Add(const S: string): Integer;
  2868. begin
  2869.   Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, Longint(PChar(S)));
  2870.   if Result < 0 then raise EOutOfResources.Create(SInsertLineError);
  2871. end;
  2872.  
  2873. procedure TListBoxStrings.Insert(Index: Integer; const S: string);
  2874. begin
  2875.   if SendMessage(ListBox.Handle, LB_INSERTSTRING, Index,
  2876.     Longint(PChar(S))) < 0 then
  2877.     raise EOutOfResources.Create(SInsertLineError);
  2878. end;
  2879.  
  2880. procedure TListBoxStrings.Delete(Index: Integer);
  2881. begin
  2882.   ListBox.DeleteString( Index );
  2883. end;
  2884.  
  2885. procedure TListBoxStrings.Clear;
  2886. begin
  2887.   ListBox.ResetContent;
  2888. end;
  2889.  
  2890. procedure TListBoxStrings.SetUpdateState(Updating: Boolean);
  2891. begin
  2892.   SendMessage(ListBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  2893.   if not Updating then ListBox.Refresh;
  2894. end;
  2895.  
  2896. { TCustomListBox }
  2897.  
  2898. constructor TCustomListBox.Create(AOwner: TComponent);
  2899. const
  2900.   ListBoxStyle = [csSetCaption, csDoubleClicks];
  2901. begin
  2902.   inherited Create(AOwner);
  2903.   if NewStyleControls then
  2904.     ControlStyle := ListBoxStyle else
  2905.     ControlStyle := ListBoxStyle + [csFramed];
  2906.   Width := 121;
  2907.   Height := 97;
  2908.   TabStop := True;
  2909.   ParentColor := False;
  2910.   FItems := TListBoxStrings.Create;
  2911.   TListBoxStrings(FItems).ListBox := Self;
  2912.   FCanvas := TControlCanvas.Create;
  2913.   TControlCanvas(FCanvas).Control := Self;
  2914.   FItemHeight := 16;
  2915.   FBorderStyle := bsSingle;
  2916.   FExtendedSelect := True;
  2917. end;
  2918.  
  2919. destructor TCustomListBox.Destroy;
  2920. begin
  2921.   FCanvas.Free;
  2922.   FItems.Free;
  2923.   FSaveItems.Free;
  2924.   inherited Destroy;
  2925. end;
  2926.  
  2927. function TCustomListBox.GetItemData(Index: Integer): LongInt;
  2928. begin
  2929.   Result := SendMessage(Handle, LB_GETITEMDATA, Index, 0);
  2930. end;
  2931.  
  2932. procedure TCustomListBox.SetItemData(Index: Integer; AData: LongInt);
  2933. begin
  2934.   SendMessage(Handle, LB_SETITEMDATA, Index, AData);
  2935. end;
  2936.  
  2937. procedure TCustomListBox.DeleteString( Index: Integer );
  2938. begin
  2939.   SendMessage(Handle, LB_DELETESTRING, Index, 0);
  2940. end;
  2941.  
  2942. procedure TCustomListBox.ResetContent;
  2943. begin
  2944.   SendMessage(Handle, LB_RESETCONTENT, 0, 0);
  2945. end;
  2946.  
  2947. procedure TCustomListBox.Clear;
  2948. begin
  2949.   FItems.Clear;
  2950. end;
  2951.  
  2952. procedure TCustomListBox.SetColumnWidth;
  2953. begin
  2954.   if FColumns > 0 then
  2955.     SendMessage(Handle, LB_SETCOLUMNWIDTH,
  2956.       (Width + FColumns - 3) div FColumns, 0);
  2957. end;
  2958.  
  2959. procedure TCustomListBox.SetColumns(Value: Integer);
  2960. begin
  2961.   if FColumns <> Value then
  2962.     if (FColumns = 0) or (Value = 0) then
  2963.     begin
  2964.       FColumns := Value;
  2965.       RecreateWnd;
  2966.     end else
  2967.     begin
  2968.       FColumns := Value;
  2969.       if HandleAllocated then SetColumnWidth;
  2970.     end;
  2971. end;
  2972.  
  2973. function TCustomListBox.GetItemIndex: Integer;
  2974. begin
  2975.   Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
  2976. end;
  2977.  
  2978. function TCustomListBox.GetSelCount: Integer;
  2979. begin
  2980.   Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
  2981. end;
  2982.  
  2983. procedure TCustomListBox.SetItemIndex(Value: Integer);
  2984. begin
  2985.   if GetItemIndex <> Value then
  2986.     SendMessage(Handle, LB_SETCURSEL, Value, 0);
  2987. end;
  2988.  
  2989. procedure TCustomListBox.SetExtendedSelect(Value: Boolean);
  2990. begin
  2991.   if Value <> FExtendedSelect then
  2992.   begin
  2993.     FExtendedSelect := Value;
  2994.     RecreateWnd;
  2995.   end;
  2996. end;
  2997.  
  2998. procedure TCustomListBox.SetIntegralHeight(Value: Boolean);
  2999. begin
  3000.   if Value <> FIntegralHeight then
  3001.   begin
  3002.     FIntegralHeight := Value;
  3003.     RecreateWnd;
  3004.   end;
  3005. end;
  3006.  
  3007. function TCustomListBox.GetItemHeight: Integer;
  3008. var
  3009.   R: TRect;
  3010. begin
  3011.   Result := FItemHeight;
  3012.   if HandleAllocated and (FStyle = lbStandard) then
  3013.   begin
  3014.     Perform(LB_GETITEMRECT, 0, Longint(@R));
  3015.     Result := R.Bottom - R.Top;
  3016.   end;
  3017. end;
  3018.  
  3019. procedure TCustomListBox.SetItemHeight(Value: Integer);
  3020. begin
  3021.   if (FItemHeight <> Value) and (Value > 0) then
  3022.   begin
  3023.     FItemHeight := Value;
  3024.     RecreateWnd;
  3025.   end;
  3026. end;
  3027.  
  3028. procedure TCustomListBox.SetTabWidth(Value: Integer);
  3029. begin
  3030.   if Value < 0 then Value := 0;
  3031.   if FTabWidth <> Value then
  3032.   begin
  3033.     FTabWidth := Value;
  3034.     RecreateWnd;
  3035.   end;
  3036. end;
  3037.  
  3038. procedure TCustomListBox.SetMultiSelect(Value: Boolean);
  3039. begin
  3040.   if FMultiSelect <> Value then
  3041.   begin
  3042.     FMultiSelect := Value;
  3043.     RecreateWnd;
  3044.   end;
  3045. end;
  3046.  
  3047. function TCustomListBox.GetSelected(Index: Integer): Boolean;
  3048. var
  3049.   R: Longint;
  3050. begin
  3051.   R := SendMessage(Handle, LB_GETSEL, Index, 0);
  3052.   if R = LB_ERR then
  3053.     raise EListError.CreateFmt(SListIndexError, [Index]);
  3054.   Result := LongBool(R);
  3055. end;
  3056.  
  3057. procedure TCustomListBox.SetSelected(Index: Integer; Value: Boolean);
  3058. begin
  3059.   if SendMessage(Handle, LB_SETSEL, Longint(Value), Index) = LB_ERR then
  3060.     raise EListError.CreateFmt(SListIndexError, [Index]);
  3061. end;
  3062.  
  3063. procedure TCustomListBox.SetSorted(Value: Boolean);
  3064. begin
  3065.   if FSorted <> Value then
  3066.   begin
  3067.     FSorted := Value;
  3068.     RecreateWnd;
  3069.   end;
  3070. end;
  3071.  
  3072. procedure TCustomListBox.SetStyle(Value: TListBoxStyle);
  3073. begin
  3074.   if FStyle <> Value then
  3075.   begin
  3076.     FStyle := Value;
  3077.     RecreateWnd;
  3078.   end;
  3079. end;
  3080.  
  3081. function TCustomListBox.GetTopIndex: Integer;
  3082. begin
  3083.   Result := SendMessage(Handle, LB_GETTOPINDEX, 0, 0);
  3084. end;
  3085.  
  3086. procedure TCustomListBox.SetBorderStyle(Value: TBorderStyle);
  3087. begin
  3088.   if FBorderStyle <> Value then
  3089.   begin
  3090.     FBorderStyle := Value;
  3091.     RecreateWnd;
  3092.   end;
  3093. end;
  3094.  
  3095. procedure TCustomListBox.SetTopIndex(Value: Integer);
  3096. begin
  3097.   if GetTopIndex <> Value then
  3098.     SendMessage(Handle, LB_SETTOPINDEX, Value, 0);
  3099. end;
  3100.  
  3101. procedure TCustomListBox.SetItems(Value: TStrings);
  3102. begin
  3103.   Items.Assign(Value);
  3104. end;
  3105.  
  3106. function TCustomListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
  3107. var
  3108.   Count: Integer;
  3109.   ItemRect: TRect;
  3110. begin
  3111.   if PtInRect(ClientRect, Pos) then
  3112.   begin
  3113.     Result := TopIndex;
  3114.     Count := Items.Count;
  3115.     while Result < Count do
  3116.     begin
  3117.       Perform(LB_GETITEMRECT, Result, Longint(@ItemRect));
  3118.       if PtInRect(ItemRect, Pos) then Exit;
  3119.       Inc(Result);
  3120.     end;
  3121.     if not Existing then Exit;
  3122.   end;
  3123.   Result := -1;
  3124. end;
  3125.  
  3126. function TCustomListBox.ItemRect(Index: Integer): TRect;
  3127. var
  3128.   Count: Integer;
  3129. begin
  3130.   Count := Items.Count;
  3131.   if (Index = 0) or (Index < Count) then
  3132.     Perform(LB_GETITEMRECT, Index, Longint(@Result))
  3133.   else if Index = Count then
  3134.   begin
  3135.     Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
  3136.     OffsetRect(Result, 0, Result.Bottom - Result.Top);
  3137.   end else FillChar(Result, SizeOf(Result), 0);
  3138. end;
  3139.  
  3140. procedure TCustomListBox.CreateParams(var Params: TCreateParams);
  3141. type
  3142.   PSelects = ^TSelects;
  3143.   TSelects = array[Boolean] of Longint;
  3144. const
  3145.   Styles: array[TListBoxStyle] of Longint =
  3146.     (0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE);
  3147.   Sorteds: array[Boolean] of Longint = (0, LBS_SORT);
  3148.   MultiSelects: array[Boolean] of Longint = (0, LBS_MULTIPLESEL);
  3149.   ExtendSelects: array[Boolean] of Longint = (0, LBS_EXTENDEDSEL);
  3150.   IntegralHeights: array[Boolean] of Longint = (LBS_NOINTEGRALHEIGHT, 0);
  3151.   MultiColumns: array[Boolean] of Longint = (0, LBS_MULTICOLUMN);
  3152.   TabStops: array[Boolean] of Longint = (0, LBS_USETABSTOPS);
  3153. var
  3154.   Selects: PSelects;
  3155. begin
  3156.   inherited CreateParams(Params);
  3157.   CreateSubClass(Params, 'LISTBOX');
  3158.   with Params do
  3159.   begin
  3160.     Selects := @MultiSelects;
  3161.     if FExtendedSelect then Selects := @ExtendSelects;
  3162.     Style := Style or (WS_HSCROLL or WS_VSCROLL or LBS_HASSTRINGS or
  3163.       LBS_NOTIFY) or Styles[FStyle] or Sorteds[FSorted] or
  3164.       Selects^[FMultiSelect] or IntegralHeights[FIntegralHeight] or
  3165.       MultiColumns[FColumns <> 0] or BorderStyles[FBorderStyle] or
  3166.       TabStops[FTabWidth <> 0];
  3167.     if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  3168.     begin
  3169.       Style := Style and not WS_BORDER;
  3170.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  3171.     end;
  3172.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  3173.   end;
  3174. end;
  3175.  
  3176. procedure TCustomListBox.CreateWnd;
  3177. var
  3178.   W, H: Integer;
  3179. begin
  3180.   W := Width;
  3181.   H := Height;
  3182.   inherited CreateWnd;
  3183.   SetWindowPos(Handle, 0, Left, Top, W, H, SWP_NOZORDER or SWP_NOACTIVATE);
  3184.   if FTabWidth <> 0 then
  3185.     SendMessage(Handle, LB_SETTABSTOPS, 1, Longint(@FTabWidth));
  3186.   SetColumnWidth;
  3187.   if FSaveItems <> nil then
  3188.   begin
  3189.     FItems.Assign(FSaveItems);
  3190.     SetTopIndex(FSaveTopIndex);
  3191.     SetItemIndex(FSaveItemIndex);
  3192.     FSaveItems.Free;
  3193.     FSaveItems := nil;
  3194.   end;
  3195. end;
  3196.  
  3197. procedure TCustomListBox.DestroyWnd;
  3198. begin
  3199.   if FItems.Count > 0 then
  3200.   begin
  3201.     FSaveItems := TStringList.Create;
  3202.     FSaveItems.Assign(FItems);
  3203.     FSaveTopIndex := GetTopIndex;
  3204.     FSaveItemIndex := GetItemIndex;
  3205.   end;
  3206.   inherited DestroyWnd;
  3207. end;
  3208.  
  3209. procedure TCustomListBox.WndProc(var Message: TMessage);
  3210. begin
  3211.   {for auto drag mode, let listbox handle itself, instead of TControl}
  3212.   if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
  3213.     (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
  3214.   begin
  3215.     if DragMode = dmAutomatic then
  3216.     begin
  3217.       if IsControlMouseMsg(TWMMouse(Message)) then
  3218.         Exit;
  3219.       ControlState := ControlState + [csLButtonDown];
  3220.       Dispatch(Message);  {overrides TControl's BeginDrag}
  3221.       Exit;
  3222.     end;
  3223.   end;
  3224.   inherited WndProc(Message);
  3225. end;
  3226.  
  3227. procedure TCustomListBox.WMLButtonDown(var Message: TWMLButtonDown);
  3228. var
  3229.   ItemNo : Integer;
  3230.   ShiftState: TShiftState;
  3231. begin
  3232.   ShiftState := KeysToShiftState(Message.Keys);
  3233.   if (DragMode = dmAutomatic) and FMultiSelect then
  3234.   begin
  3235.     if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then
  3236.     begin
  3237.       ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
  3238.       if (ItemNo >= 0) and (Selected[ItemNo]) then
  3239.       begin
  3240.         BeginDrag (False);
  3241.         Exit;
  3242.       end;
  3243.     end;
  3244.   end;
  3245.   inherited;
  3246.   if (DragMode = dmAutomatic) and not (FMultiSelect and
  3247.     ((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
  3248.     BeginDrag(False);
  3249. end;
  3250.  
  3251. procedure TCustomListBox.CNCommand(var Message: TWMCommand);
  3252. begin
  3253.   case Message.NotifyCode of
  3254.     LBN_SELCHANGE:
  3255.       begin
  3256.         inherited Changed;
  3257.         Click;
  3258.       end;
  3259.     LBN_DBLCLK: DblClick;
  3260.   end;
  3261. end;
  3262.  
  3263. procedure TCustomListBox.WMPaint(var Message: TWMPaint);
  3264.  
  3265.   procedure PaintListBox;
  3266.   var
  3267.     DrawItemMsg: TWMDrawItem;
  3268.     MeasureItemMsg: TWMMeasureItem;
  3269.     DrawItemStruct: TDrawItemStruct;
  3270.     MeasureItemStruct: TMeasureItemStruct;
  3271.     R: TRect;
  3272.     Y, I, H, W: Integer;
  3273.   begin
  3274.     { Initialize drawing records }
  3275.     DrawItemMsg.Msg := CN_DRAWITEM;
  3276.     DrawItemMsg.DrawItemStruct := @DrawItemStruct;
  3277.     DrawItemMsg.Ctl := Handle;
  3278.     DrawItemStruct.CtlType := ODT_LISTBOX;
  3279.     DrawItemStruct.itemAction := ODA_DRAWENTIRE;
  3280.     DrawItemStruct.itemState := 0;
  3281.     DrawItemStruct.hDC := Message.DC;
  3282.     DrawItemStruct.CtlID := Handle;
  3283.     DrawItemStruct.hwndItem := Handle;
  3284.  
  3285.     { Intialize measure records }
  3286.     MeasureItemMsg.Msg := CN_MEASUREITEM;
  3287.     MeasureItemMsg.IDCtl := Handle;
  3288.     MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
  3289.     MeasureItemStruct.CtlType := ODT_LISTBOX;
  3290.     MeasureItemStruct.CtlID := Handle;
  3291.  
  3292.     { Draw the listbox }
  3293.     Y := 0;
  3294.     I := TopIndex;
  3295.     GetClipBox(Message.DC, R);
  3296.     H := Height;
  3297.     W := Width;
  3298.     while Y < H do
  3299.     begin
  3300.       MeasureItemStruct.itemID := I;
  3301.       if I < Items.Count then
  3302.         MeasureItemStruct.itemData := Longint(Pointer(Items.Objects[I]));
  3303.       MeasureItemStruct.itemWidth := W;
  3304.       MeasureItemStruct.itemHeight := FItemHeight;
  3305.       DrawItemStruct.itemData := MeasureItemStruct.itemData;
  3306.       DrawItemStruct.itemID := I;
  3307.       Dispatch(MeasureItemMsg);
  3308.       DrawItemStruct.rcItem := Rect(0, Y, MeasureItemStruct.itemWidth,
  3309.         Y + MeasureItemStruct.itemHeight);
  3310.       Dispatch(DrawItemMsg);
  3311.       Inc(Y, MeasureItemStruct.itemHeight);
  3312.       Inc(I);
  3313.       if I >= Items.Count then break;
  3314.     end;
  3315.   end;
  3316.  
  3317. begin
  3318.   if Message.DC <> 0 then
  3319.     { Listboxes don't allow paint "sub-classing" like the other windows controls
  3320.       so we have to do it ourselves. }
  3321.     PaintListBox
  3322.   else inherited;
  3323. end;
  3324.  
  3325. procedure TCustomListBox.WMSize(var Message: TWMSize);
  3326. begin
  3327.   inherited;
  3328.   SetColumnWidth;
  3329. end;
  3330.  
  3331. procedure TCustomListBox.DragCanceled;
  3332. var
  3333.   M: TWMMouse;
  3334.   MousePos: TPoint;
  3335. begin
  3336.   with M do
  3337.   begin
  3338.     Msg := WM_LBUTTONDOWN;
  3339.     GetCursorPos(MousePos);
  3340.     Pos := PointToSmallPoint(ScreenToClient(MousePos));
  3341.     Keys := 0;
  3342.     Result := 0;
  3343.   end;
  3344.   DefaultHandler(M);
  3345.   M.Msg := WM_LBUTTONUP;
  3346.   DefaultHandler(M);
  3347. end;
  3348.  
  3349. procedure TCustomListBox.DrawItem(Index: Integer; Rect: TRect;
  3350.   State: TOwnerDrawState);
  3351. begin
  3352.   if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State) else
  3353.   begin
  3354.     FCanvas.FillRect(Rect);
  3355.     if Index < Items.Count then
  3356.       FCanvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]);
  3357.   end;
  3358. end;
  3359.  
  3360. procedure TCustomListBox.MeasureItem(Index: Integer; var Height: Integer);
  3361. begin
  3362.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
  3363. end;
  3364.  
  3365. procedure TCustomListBox.CNDrawItem(var Message: TWMDrawItem);
  3366. var
  3367.   State: TOwnerDrawState;
  3368. begin
  3369.   with Message.DrawItemStruct^ do
  3370.   begin
  3371.     State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  3372.     FCanvas.Handle := hDC;
  3373.     FCanvas.Font := Font;
  3374.     FCanvas.Brush := Brush;
  3375.     if (Integer(itemID) >= 0) and (odSelected in State) then
  3376.     begin
  3377.       FCanvas.Brush.Color := clHighlight;
  3378.       FCanvas.Font.Color := clHighlightText
  3379.     end;
  3380.     if Integer(itemID) >= 0 then
  3381.       DrawItem(itemID, rcItem, State) else
  3382.       FCanvas.FillRect(rcItem);
  3383.     if odFocused in State then DrawFocusRect(hDC, rcItem);
  3384.     FCanvas.Handle := 0;
  3385.   end;
  3386. end;
  3387.  
  3388. procedure TCustomListBox.CNMeasureItem(var Message: TWMMeasureItem);
  3389. begin
  3390.   with Message.MeasureItemStruct^ do
  3391.   begin
  3392.     itemHeight := FItemHeight;
  3393.     if FStyle = lbOwnerDrawVariable then
  3394.       MeasureItem(itemID, Integer(itemHeight));
  3395.   end;
  3396. end;
  3397.  
  3398. procedure TCustomListBox.CMCtl3DChanged(var Message: TMessage);
  3399. begin
  3400.   if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
  3401.   inherited;
  3402. end;
  3403.  
  3404. { TScrollBar }
  3405.  
  3406. constructor TScrollBar.Create(AOwner: TComponent);
  3407. begin
  3408.   inherited Create(AOwner);
  3409.   Width := 121;
  3410.   Height := GetSystemMetrics(SM_CYHSCROLL);
  3411.   TabStop := True;
  3412.   ControlStyle := [csFramed, csDoubleClicks];
  3413.   FKind := sbHorizontal;
  3414.   FPosition := 0;
  3415.   FMin := 0;
  3416.   FMax := 100;
  3417.   FSmallChange := 1;
  3418.   FLargeChange := 1;
  3419. end;
  3420.  
  3421. procedure TScrollBar.CreateParams(var Params: TCreateParams);
  3422. const
  3423.   Kinds: array[TScrollBarKind] of LongInt = (SBS_HORZ, SBS_VERT);
  3424. begin
  3425.   inherited CreateParams(Params);
  3426.   CreateSubClass(Params, 'SCROLLBAR');
  3427.   Params.Style := Params.Style or Kinds[FKind];
  3428. end;
  3429.  
  3430. procedure TScrollBar.CreateWnd;
  3431. begin
  3432.   inherited CreateWnd;
  3433.   SetScrollRange(Handle, SB_CTL, FMin, FMax, False);
  3434.   SetScrollPos(Handle, SB_CTL, FPosition, True);
  3435. end;
  3436.  
  3437. procedure TScrollBar.SetKind(Value: TScrollBarKind);
  3438. begin
  3439.   if FKind <> Value then
  3440.   begin
  3441.     FKind := Value;
  3442.     if not (csLoading in ComponentState) then SetBounds(Left, Top, Height, Width);
  3443.     RecreateWnd;
  3444.   end;
  3445. end;
  3446.  
  3447. procedure TScrollBar.SetParams(APosition, AMin, AMax: Integer);
  3448. begin
  3449.   if AMax < AMin then
  3450.     raise EInvalidOperation.Create(SScrollBarRange);
  3451.   if APosition < AMin then APosition := AMin;
  3452.   if APosition > AMax then APosition := AMax;
  3453.   if (FMin <> AMin) or (FMax <> AMax) then
  3454.   begin
  3455.     FMin := AMin;
  3456.     FMax := AMax;
  3457.     if HandleAllocated then
  3458.       SetScrollRange(Handle, SB_CTL, AMin, AMax, FPosition = APosition);
  3459.   end;
  3460.   if FPosition <> APosition then
  3461.   begin
  3462.     FPosition := APosition;
  3463.     if HandleAllocated then SetScrollPos(Handle, SB_CTL, APosition, True);
  3464.     Change;
  3465.   end;
  3466. end;
  3467.  
  3468. procedure TScrollBar.SetPosition(Value: Integer);
  3469. begin
  3470.   SetParams(Value, FMin, FMax);
  3471. end;
  3472.  
  3473. procedure TScrollBar.SetMin(Value: Integer);
  3474. begin
  3475.   SetParams(FPosition, Value, FMax);
  3476. end;
  3477.  
  3478. procedure TScrollBar.SetMax(Value: Integer);
  3479. begin
  3480.   SetParams(FPosition, FMin, Value);
  3481. end;
  3482.  
  3483. procedure TScrollBar.Change;
  3484. begin
  3485.   inherited Changed;
  3486.   if Assigned(FOnChange) then FOnChange(Self);
  3487. end;
  3488.  
  3489. procedure TScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
  3490. begin
  3491.   if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
  3492. end;
  3493.  
  3494. procedure TScrollBar.DoScroll(var Message: TWMScroll);
  3495. var
  3496.   ScrollPos: Integer;
  3497.   NewPos: Longint;
  3498.   ScrollInfo: TScrollInfo;
  3499. begin
  3500.   with Message do
  3501.   begin
  3502.     NewPos := FPosition;
  3503.     case TScrollCode(ScrollCode) of
  3504.       scLineUp:
  3505.         Dec(NewPos, FSmallChange);
  3506.       scLineDown:
  3507.         Inc(NewPos, FSmallChange);
  3508.       scPageUp:
  3509.         Dec(NewPos, FLargeChange);
  3510.       scPageDown:
  3511.         Inc(NewPos, FLargeChange);
  3512.       scPosition, scTrack:
  3513.         with ScrollInfo do
  3514.         begin
  3515.           cbSize := SizeOf(ScrollInfo);
  3516.           fMask := SIF_ALL;
  3517.           GetScrollInfo(Handle, SB_CTL, ScrollInfo);
  3518.           NewPos := nTrackPos;
  3519.         end;
  3520.       scTop:
  3521.         NewPos := FMin;
  3522.       scBottom:
  3523.         NewPos := FMax;
  3524.     end;
  3525.     if NewPos < FMin then NewPos := FMin;
  3526.     if NewPos > FMax then NewPos := FMax;
  3527.     ScrollPos := NewPos;
  3528.     Scroll(TScrollCode(ScrollCode), ScrollPos);
  3529.     SetPosition(ScrollPos);
  3530.   end;
  3531. end;
  3532.  
  3533. procedure TScrollBar.CNHScroll(var Message: TWMHScroll);
  3534. begin
  3535.   DoScroll(Message);
  3536. end;
  3537.  
  3538. procedure TScrollBar.CNVScroll(var Message: TWMVScroll);
  3539. begin
  3540.   DoScroll(Message);
  3541. end;
  3542.  
  3543. procedure TScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  3544. begin
  3545.   DefaultHandler(Message);
  3546. end;
  3547.  
  3548. { TCustomStaticText }
  3549.  
  3550. constructor TCustomStaticText.Create(AOwner: TComponent);
  3551. begin
  3552.   inherited Create(AOwner);
  3553.   ControlStyle := [csCaptureMouse, csClickEvents, csSetCaption,
  3554.     csOpaque, csReplicatable, csDoubleClicks];
  3555.   Width := 65;
  3556.   Height := 17;
  3557.   FAutoSize := True;
  3558.   FShowAccelChar := True;
  3559.   AdjustBounds;
  3560. end;
  3561.  
  3562. procedure TCustomStaticText.CreateParams(var Params: TCreateParams);
  3563. const
  3564.   Alignments: array[TAlignment] of Integer = (SS_LEFT, SS_RIGHT, SS_CENTER);
  3565.   Borders: array[TStaticBorderStyle] of Integer = (0, WS_BORDER, SS_SUNKEN);
  3566. begin
  3567.   inherited CreateParams(Params);
  3568.   CreateSubClass(Params, 'STATIC');
  3569.   with Params do
  3570.   begin
  3571.     Style := Style or SS_NOTIFY or Alignments[FAlignment] or Borders[FBorderStyle];
  3572.     if not FShowAccelChar then Style := Style or SS_NOPREFIX;
  3573.   end;
  3574. end;
  3575.  
  3576. procedure TCustomStaticText.CMDialogChar(var Message: TCMDialogChar);
  3577. begin
  3578.   if (FFocusControl <> nil) and Enabled and ShowAccelChar and
  3579.     IsAccel(Message.CharCode, Caption) then
  3580.     with FFocusControl do
  3581.       if CanFocus then
  3582.       begin
  3583.         SetFocus;
  3584.         Message.Result := 1;
  3585.       end;
  3586. end;
  3587.  
  3588. procedure TCustomStaticText.CMFontChanged(var Message: TMessage);
  3589. begin
  3590.   inherited;
  3591.   AdjustBounds;
  3592. end;
  3593.  
  3594. procedure TCustomStaticText.CMTextChanged(var Message: TMessage);
  3595. begin
  3596.   inherited;
  3597.   AdjustBounds;
  3598. end;
  3599.  
  3600. procedure TCustomStaticText.AdjustBounds;
  3601. var
  3602.   DC: HDC;
  3603.   SaveFont: HFont;
  3604.   TextSize: TSize;
  3605. begin
  3606.   if not (csReading in ComponentState) and FAutoSize then
  3607.   begin
  3608.     DC := GetDC(0);
  3609.     SaveFont := SelectObject(DC, Font.Handle);
  3610.     GetTextExtentPoint32(DC, PChar(Caption), Length(Caption), TextSize);
  3611.     SelectObject(DC, SaveFont);
  3612.     ReleaseDC(0, DC);
  3613.     SetBounds(Left, Top,
  3614.       TextSize.cx + (GetSystemMetrics(SM_CXBORDER) * 4),
  3615.       TextSize.cy + (GetSystemMetrics(SM_CYBORDER) * 4));
  3616.   end;
  3617. end;
  3618.  
  3619. procedure TCustomStaticText.Notification(AComponent: TComponent;
  3620.   Operation: TOperation);
  3621. begin
  3622.   inherited Notification(AComponent, Operation);
  3623.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  3624.     FFocusControl := nil;
  3625. end;
  3626.  
  3627. procedure TCustomStaticText.SetAlignment(Value: TAlignment);
  3628. begin
  3629.   if FAlignment <> Value then
  3630.   begin
  3631.     FAlignment := Value;
  3632.     RecreateWnd;
  3633.   end;
  3634. end;
  3635.  
  3636. procedure TCustomStaticText.SetAutoSize(Value: Boolean);
  3637. begin
  3638.   if FAutoSize <> Value then
  3639.   begin
  3640.     FAutoSize := Value;
  3641.     if Value then AdjustBounds;
  3642.   end;
  3643. end;
  3644.  
  3645. procedure TCustomStaticText.SetBorderStyle(Value: TStaticBorderStyle);
  3646. begin
  3647.   if FBorderStyle <> Value then
  3648.   begin
  3649.     FBorderStyle := Value;
  3650.     RecreateWnd;
  3651.   end;
  3652. end;
  3653.  
  3654. procedure TCustomStaticText.SetFocusControl(Value: TWinControl);
  3655. begin
  3656.   FFocusControl := Value;
  3657.   if Value <> nil then Value.FreeNotification(Self);
  3658. end;
  3659.  
  3660. procedure TCustomStaticText.SetShowAccelChar(Value: Boolean);
  3661. begin
  3662.   if FShowAccelChar <> Value then
  3663.   begin
  3664.     FShowAccelChar := Value;
  3665.     RecreateWnd;
  3666.   end;
  3667. end;
  3668.  
  3669. end.
  3670.